home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 1997 May / PC Plus Super CD Issue 127 (May 1997).iso / handson / wilf / gravity.bas < prev    next >
Encoding:
BASIC Source File  |  1997-04-30  |  63.4 KB  |  2,810 lines
  1. '  "GRAVITY.BAS"  (c) UK 1997 Future Publishing
  2. '    written by Wilf Hey and Paul Grosse
  3. '<->
  4. DEFINT A-Z
  5. DECLARE SUB ziDragging ()
  6. ' Return if mouse active and still dragging, or else exhausted
  7.  
  8. DECLARE SUB ziDrawBank (FromButton, ToButton)
  9. ' Draw a bank of buttons (using Bank array)
  10.  
  11. DECLARE SUB ziExhaust ()
  12. ' Return when no keystrokes and no mouse buttons
  13.  
  14. DECLARE SUB ziLoadFont (Font$)
  15. ' Load a specified font
  16.  
  17. DECLARE SUB ziLocateMCursor (Xcoord, Ycoord)
  18. ' Locate mouse cursor to a named point
  19.  
  20. DECLARE SUB ziMouseOnButton (FromButton, ToButton)
  21. ' Sets FoundButton
  22.  
  23. DECLARE SUB ziPublish (Printstring$, size, italic)
  24. ' Print a string at graphics cursor (advanced)
  25. '   Size   = magnitude (per 8 pixels)
  26. '   Italic = +1 to make italic
  27. '          = +2 to make overprint (no background)
  28.  
  29. DECLARE SUB ziPublishHere (row, col, Printstring$, size, italic)
  30. ' Print a string at the specified text position
  31.  
  32. DECLARE SUB ziRadio (Button, FromButton, ToButton)
  33. ' Set one button in a Bank, resetting the rest
  34.  
  35. DECLARE SUB ziReadField (Min, Max, Permitted$)
  36. ' Read a field at the current TCursor location
  37. '   Permitted$ contains:
  38. '     * - any characters
  39. '     . - allow one full-stop (as decimal)
  40. '     A - auto-enter (when filled)
  41. '     C - capitalise letters
  42. '     E - ESC allowed to finish (skip) field
  43. '     J - justify (especially for numeric)
  44. '     N - numerics
  45. '     P - password-type display
  46. '     S - space
  47. '     X - alphabetic
  48. '     Y - Y or N (upper or lower)
  49.  
  50. DECLARE SUB ziSetMCursorVis (Status)
  51. ' Set visibility of mouse cursor
  52. '   Status = 0 for OFF
  53. '            1 for ON
  54. '            2 for ENQUIRE (set MCursorVis)
  55. '           10 for TEMPORARILY OFF
  56. '           11 for RESTORED (set MCursorVis)
  57.  
  58. DECLARE SUB ziWander (Timeout!)
  59. ' Timeout  = in seconds (0 = none)
  60. ' Response =   0 = (0:00) timed out
  61. '              n = (0:n)  displacement into Allowed$
  62.  
  63. ' key           &h01xx  &h02xx  &h04xx  &h08xx  &h10xx  &h20xx  &h40xx
  64. '                plain   CTRL    shift   Mouse    Fn   CTRL-Fn  shift-Fn
  65.  
  66. ' Enter      0    *       *       -      double    -      -       -
  67. ' (left)     1    *       *       -      left     F1     ^F1     +F1
  68. ' (right)    2    *       *       -      right    F2     ^F2     +F2
  69. ' (up)       3    *       -       -      both     F3     ^F3     +F3
  70. ' (down)     4    *       -       -    leftdrag   F4     ^F4     +F4
  71.  
  72. ' Backspace  5    *       *       -    rightdrag  F5     ^F5     +F5
  73. ' Home       6    *       *       -    bothdrag   F6     ^F6     +F6
  74. ' End        7    *       *       -       -       F7     ^F7     +F7
  75.  
  76. ' PgUP       8    *       *       -       -       F8     ^F8     +F8
  77. ' PgDN       9    *       *       -       -       F9     ^F9     +F9
  78.  
  79. ' Tab       10    *       -       *       -       F10    ^F10    +F10
  80. ' Escape    11    *       -       -       -       F11    ^F11    +F11
  81. '           12    -       -       -       -       F12    ^F12    +F12
  82.  
  83. ' Allowed$  = other allowed strokes
  84. ' (Note:  DClick is a flag permitting Double-clicks of mouse - slower!)
  85.  
  86. DECLARE SUB zsAlignGCursor ()
  87. ' Align graphic cursor to same as text cursor
  88. '  - sets Row, Col, GXloc, GYloc
  89.  
  90. DECLARE SUB zsAlignTCursor ()
  91. ' Align text cursor to same as graphic cursor
  92. '  - sets Row, Col, GXloc, GYloc
  93.  
  94. DECLARE SUB zsLocateGCursor (Xcoord, Ycoord)
  95. ' Locate graphic cursor to a named point
  96.  
  97. DECLARE SUB zsPastel (Xcoord, Ycoord, Wide, Deep, colour1, colour2)
  98. ' Colour the defined oblong with a pastel mix of two colours
  99. '  Deep = 0 or 1 - square
  100. '       = n      - Y-pixel depth
  101.  
  102. DECLARE SUB zsSetScrnMode (Mode, HiRows, HiCols)
  103. ' Mode = 9, 12 or 13
  104. ' HiRows = 1 to make high number of rows
  105. ' HiCols = 1 to make high number of cols (80)
  106. ' Set SCREEN parameters and blank the screen
  107. '  - sets ScrnMode, Xmax, Ymax, Rows, Cols, XYRatio!
  108. '  - uses FG and optionally BG (colours)
  109.  
  110. DECLARE SUB zsSubstitute (Xcoord, Ycoord, Wide, Deep, colour1, colour2)
  111. ' Substitute one colour with another within the defined oblong
  112. '  Deep = 0 or 1 - square
  113. '       = n      - Y-pixel depth
  114.  
  115. DECLARE SUB zzAlphaSort (Table$())
  116. ' Sort alphabetically the strings in the table; limited by " SortCount"
  117.  
  118. DECLARE SUB zzBasicInt (IntType)
  119. ' Execute interrupt (params in REGS.AX etc)
  120.  
  121. DECLARE SUB zzChangeDir (Directory$)
  122. ' Change to a particular directory
  123. '  -sets Directory$; eg "." will be changed to current directory
  124. ' if error occurs, Directory$ is returned as "?"
  125.  
  126. DECLARE SUB zzChangeDrive (Drive$)
  127. ' Change to a particular drive
  128. ' if Drive$ is empty on input, current drive is returned
  129. ' if error occurs, Drive$ is returned as "?"
  130.  
  131. DECLARE SUB zzCritOff ()
  132. ' turns off Critical Error Handling
  133.  
  134. DECLARE SUB zzCritOn ()
  135. ' restores normal Critical Error Handling
  136.  
  137. DECLARE SUB zzFileSelectBox (Pattern$)
  138. ' File Select Box function to choose an input file
  139.  
  140. DECLARE SUB zzInPath (Field$)
  141. ' Return full path to a file (in same string)
  142.  
  143. DECLARE SUB zzSearchD (Pattern$)
  144. ' Search for DIRECTORIES matching the pattern
  145. '  - sets Directories and Directories$()
  146.  
  147. DECLARE SUB zzSearchF (Pattern$)
  148. ' Search for FIILENAMES matching the pattern
  149. '  - sets FileNames and FileNames$()
  150.  
  151. DECLARE SUB zzValidate (Directory$)
  152. ' validate the named path and return its full
  153. '   (unqualified) name, including drive
  154. ' if error occcurs, Directory$ is returned as "?"
  155.  
  156. '================================================
  157. '/  UK copyright (c) 1997 by Future Publishing
  158. '/
  159. '/
  160. '/
  161. '/
  162. '================================================
  163. TYPE REGISTERS
  164.   AX AS INTEGER
  165.   BX AS INTEGER
  166.   CX AS INTEGER
  167.   DX AS INTEGER
  168.   DS AS INTEGER
  169.   SI AS INTEGER
  170.   ES AS INTEGER
  171.   DI AS INTEGER
  172.   FL AS INTEGER
  173. END TYPE
  174.  
  175. TYPE Buttons
  176.   Xloc AS INTEGER
  177.   Yloc AS INTEGER
  178.   Wide AS INTEGER
  179.   Deep AS INTEGER
  180. '  0 = checkbutton
  181. '  1 = square sculptured
  182. '  n = Y-pixels deep
  183.   State AS INTEGER
  184. '  0 = off
  185. '  1 = on
  186.   Active AS INTEGER
  187. '  0 = inactive
  188. '  1 = active
  189. END TYPE
  190.  
  191. CONST Pi! = 3.14159
  192. CONST Ex! = 2.71828
  193. CONST DegToRad! = .0174533
  194. CONST RadToDeg! = 57.2958
  195.  
  196. CONST ziNoShift = &H1
  197. CONST ziCTRL = &H2
  198. CONST ziShift = &H4
  199. CONST ziMouse = &H8
  200. CONST ziFn = &H10
  201. CONST ziCTRLFn = &H20
  202. CONST ziShiftFn = &H40
  203.  
  204. CONST ziL = 1
  205. CONST ziR = 2
  206. CONST ziUp = 3
  207. CONST ziDn = 4
  208. CONST ziBS = 5
  209. CONST ziHome = 6
  210. CONST ziEnd = 7
  211. CONST ziPgUp = 8
  212. CONST ziPgDn = 9
  213. CONST ziTab = 10
  214. CONST ziEsc = 11
  215.  
  216. CONST ziDbl = 0
  217. CONST ziBoth = 3
  218. CONST ziLDrag = 4
  219. CONST ziRDrag = 5
  220. CONST ziBothDrag = 6
  221.  
  222. DIM SHARED Regs AS REGISTERS
  223. DIM SHARED Bank(20) AS Buttons
  224. DIM SHARED Bad, Module$
  225. DIM SHARED Mouse, MCursorVis, MXloc, MYloc
  226. DIM SHARED DClick
  227. DIM SHARED ScrnMode, bg, fg, TCursor
  228. DIM SHARED Xmax, Ymax, GXloc, GYloc, XYratio!
  229. DIM SHARED Rows, Cols, row, col
  230. DIM SHARED Allowed$, Field$
  231. DIM SHARED FoundButton
  232. DIM SHARED Font(255, 7)
  233. DIM SHARED Response, HResponse, LResponse
  234. DIM SHARED SortCount
  235. REDIM SHARED Directories$(500)
  236. REDIM SHARED FileNames$(500)
  237. DIM SHARED Directories, FileNames
  238.  
  239. DIM SHARED IRET AS STRING * 3
  240. IRET = CHR$(&HB0) + CHR$(&H0) + CHR$(&HCF)
  241. DIM SHARED CritSeg, CritPtr, CritCount
  242.  
  243. '++++++++++++++++++++++++
  244. RANDOMIZE TIMER
  245. ON ERROR GOTO RESUMENEXT
  246. RESUMENEXT:
  247.   IF ERR = 255 THEN
  248.     CLS
  249.     BEEP
  250.     PRINT "Cannot find module "; Module$
  251.     SLEEP
  252.     SYSTEM
  253.   END IF
  254.   IF ERR THEN
  255.     Bad = ERR
  256.     RESUME NEXT
  257.   END IF
  258. Regs.AX = &H3524
  259. CALL zzBasicInt(&H21)
  260. CritSeg = Regs.ES
  261. CritPtr = Regs.BX
  262. '++++++++++++++++++++++++
  263. ' Test for presence of a mouse
  264. Mouse = 0
  265. Regs.AX = 0
  266. CALL zzBasicInt(&H33)
  267. IF Regs.AX THEN
  268.   Mouse = 1
  269.   CALL ziSetMCursorVis(0)
  270. END IF
  271. '++++++++++++++++++++++++
  272. ' Load the ASCII font
  273. CALL ziLoadFont("Ascii8x8")
  274. '/==================================/'
  275. '/  End of Standard Piecrust code   /'
  276. '/==================================/'
  277. '<+>
  278.  
  279. 'DIM Xc AS DOUBLE, Yc AS DOUBLE, Zc AS DOUBLE
  280.  
  281. TYPE Bodytype
  282.   Mass AS DOUBLE
  283.   Xcoord AS DOUBLE
  284.   Ycoord AS DOUBLE
  285.   Zcoord AS DOUBLE
  286.   XVeloc AS DOUBLE
  287.   YVeloc AS DOUBLE
  288.   ZVeloc AS DOUBLE
  289.   NewXcoord AS DOUBLE
  290.   NewYcoord AS DOUBLE
  291.   NewZcoord AS DOUBLE
  292.   NewXVeloc AS DOUBLE
  293.   NewYVeloc AS DOUBLE
  294.   NewZVeloc AS DOUBLE
  295. END TYPE
  296.  
  297. 'Bodies() is the array that carries all information about the bodies
  298. ' DIM Bodies() AS Bodytype
  299.  
  300. 'information about drawing planet sizes according to Mass
  301. DIM Pics(35) AS LONG
  302.  
  303. tracking = -1
  304. threedee = 1
  305.  
  306. DO
  307. 'set up the screen and fill the array for drawing the bodies
  308.   endprog = 0
  309.   bg = 0: fg = 15
  310.   CALL zsSetScrnMode(12, 1, 1)
  311.   
  312.   PALETTE 2, &H3000
  313.   PALETTE 4, &H30
  314.   PALETTE 10, &H3F00
  315.   PALETTE 12, &H3F
  316.   PALETTE 14, &H3F3F
  317.  
  318.   IF SGN(threedee) > 0 THEN
  319.    LeftEye = 10: RightEye = 12
  320.   ELSE
  321.    LeftEye = 15: RightEye = 0
  322.   END IF
  323.  
  324.  
  325. 'draw different planet sizes
  326.   LINE (0, 0)-(4, 4), 0, BF
  327.   PSET (2, 2), LeftEye
  328.   GET (0, 0)-(4, 4), Pics(0)
  329.   IF SGN(threedee) > 0 THEN
  330.    LINE (0, 0)-(4, 4), 0, BF
  331.    PSET (2, 2), RightEye
  332.    GET (0, 0)-(4, 4), Pics(6)
  333.   END IF
  334.   LINE (0, 0)-(4, 4), 0, BF
  335.   PSET (2, 2), 0
  336.   PSET (1, 2), LeftEye
  337.   PSET (2, 1), LeftEye
  338.   PSET (3, 2), LeftEye
  339.   PSET (2, 3), LeftEye
  340.   GET (0, 0)-(4, 4), Pics(12)
  341.   IF SGN(threedee) > 0 THEN
  342.    LINE (0, 0)-(4, 4), 0, BF
  343.    PSET (1, 2), RightEye
  344.    PSET (2, 1), RightEye
  345.    PSET (3, 2), RightEye
  346.    PSET (2, 3), RightEye
  347.    GET (0, 0)-(4, 4), Pics(18)
  348.   END IF
  349.   LINE (0, 0)-(4, 4), 0, BF
  350.   LINE (1, 0)-(3, 0), LeftEye
  351.   LINE (0, 1)-(0, 3), LeftEye
  352.   LINE (4, 1)-(4, 3), LeftEye
  353.   LINE (1, 4)-(3, 4), LeftEye
  354.   GET (0, 0)-(4, 4), Pics(24)
  355.   IF SGN(threedee) > 0 THEN
  356.    LINE (0, 0)-(4, 4), 0, BF
  357.    LINE (1, 0)-(3, 0), RightEye
  358.    LINE (0, 1)-(0, 3), RightEye
  359.    LINE (4, 1)-(4, 3), RightEye
  360.    LINE (1, 4)-(3, 4), RightEye
  361.    GET (0, 0)-(4, 4), Pics(30)
  362.   END IF
  363.  
  364.   LINE (0, 0)-(4, 4), 0, BF
  365.  
  366.   LOCATE 1, 1
  367.   CALL zsAlignGCursor
  368.   IF SGN(tracking) > 0 THEN
  369.    fg = 15
  370.   ELSE
  371.    fg = 8
  372.   END IF
  373.   CALL ziPublish("F1 tracking", 0, 0)
  374.  
  375.   LOCATE 3, 1
  376.   CALL zsAlignGCursor
  377.   IF SGN(threedee) > 0 THEN
  378.    fg = 15
  379.   ELSE
  380.    fg = 8
  381.   END IF
  382.   CALL ziPublish("F2 3D image", 0, 0)
  383.  
  384.   IF SGN(threedee) > 0 THEN
  385.    LeftEye = 2: RightEye = 4
  386.   ELSE
  387.    LeftEye = 7: RightEye = 0
  388.   END IF
  389.  
  390.   X1 = -500: Y1 = -500: Z1 = -700
  391.   brake = 0
  392.   DO
  393.    IF SGN(X1) = -1 THEN
  394.     Xc = X1: Yc = Y1: Zc = Z1
  395.     GOSUB CalcView
  396.     x1l = XviewLeft: x1r = XviewRight: y1l = YviewLeft: y1r = YviewRight
  397.     Xc = -X1
  398.     GOSUB CalcView
  399.     x2l = XviewLeft: x2r = XviewRight: y2l = YviewLeft: y2r = YviewRight
  400.     LINE (x1l, y1l)-(x2l, y2l), LeftEye
  401.     IF SGN(threedee) > 0 THEN
  402.      LINE (x1r, y1r)-(x2r, y2r), RightEye
  403.     END IF
  404.    END IF
  405.    IF SGN(Y1) = -1 THEN
  406.     Xc = X1: Yc = Y1: Zc = Z1
  407.     GOSUB CalcView
  408.     x1l = XviewLeft: x1r = XviewRight: y1l = YviewLeft: y1r = YviewRight
  409.     Yc = -Y1
  410.     GOSUB CalcView
  411.     x2l = XviewLeft: x2r = XviewRight: y2l = YviewLeft: y2r = YviewRight
  412.     LINE (x1l, y1l)-(x2l, y2l), LeftEye
  413.     IF SGN(threedee) > 0 THEN
  414.      LINE (x1r, y1r)-(x2r, y2r), RightEye
  415.     END IF
  416.    END IF
  417.    IF SGN(Z1) = -1 THEN
  418.     Xc = X1: Yc = Y1: Zc = Z1
  419.     GOSUB CalcView
  420.     x1l = XviewLeft: x1r = XviewRight: y1l = YviewLeft: y1r = YviewRight
  421.     Zc = -Z1
  422.     GOSUB CalcView
  423.     x2l = XviewLeft: x2r = XviewRight: y2l = YviewLeft: y2r = YviewRight
  424.     LINE (x1l, y1l)-(x2l, y2l), LeftEye
  425.     IF SGN(threedee) > 0 THEN
  426.      LINE (x1r, y1r)-(x2r, y2r), RightEye
  427.     END IF
  428.    END IF
  429. ' visit each of the eight corners
  430.    X1 = -X1
  431.    IF SGN(X1) = -1 THEN
  432.     Y1 = -Y1
  433.     IF SGN(Y1) = -1 THEN
  434.      Z1 = -Z1
  435.      IF SGN(Z1) = -1 THEN
  436.       brake = 1
  437.      END IF
  438.     END IF
  439.    END IF
  440.   LOOP UNTIL brake = 1
  441.  
  442.   RESTORE Bodyinfo:
  443.   READ NumbrBodies
  444.  
  445.   REDIM Bodies(NumbrBodies) AS Bodytype
  446.   FOR ctr = 1 TO NumbrBodies
  447.    READ Bodies(ctr).Mass
  448.    READ Bodies(ctr).Xcoord, Bodies(ctr).Ycoord, Bodies(ctr).Zcoord
  449.    READ Bodies(ctr).XVeloc, Bodies(ctr).YVeloc, Bodies(ctr).ZVeloc
  450.    Bodies(ctr).NewXVeloc = Bodies(ctr).XVeloc
  451.    Bodies(ctr).NewYVeloc = Bodies(ctr).YVeloc
  452.    Bodies(ctr).NewZVeloc = Bodies(ctr).ZVeloc
  453.   NEXT
  454. ' momentum check goes here
  455. ' draw them
  456.  
  457.   FOR ctr = 1 TO NumbrBodies
  458.    Xc = Bodies(ctr).Xcoord: Yc = Bodies(ctr).Ycoord: Zc = Bodies(ctr).Zcoord
  459.    GOSUB CalcView
  460.    xl = XviewLeft: xr = XviewRight: yl = YviewLeft: yr = YviewRight
  461.    ok = -1
  462.    IF xl < 0 THEN ok = 0
  463.    IF yl < 0 THEN ok = 0
  464.    IF xr < 0 THEN ok = 0
  465.    IF yr < 0 THEN ok = 0
  466.    IF ok THEN
  467.     SELECT CASE Bodies(ctr).Mass
  468.     CASE IS < 100
  469.      PUT (xl, yl), Pics(0), XOR
  470.      IF SGN(threedee) > 0 THEN
  471.       PUT (xr, yr), Pics(6), XOR
  472.      END IF
  473.     CASE IS < 10000
  474.      PUT (xl, yl), Pics(12), XOR
  475.      IF SGN(threedee) > 0 THEN
  476.       PUT (xr, yr), Pics(18), XOR
  477.      END IF
  478.     CASE ELSE
  479.      PUT (xl, yl), Pics(24), XOR
  480.      IF SGN(threedee) > 0 THEN
  481.       PUT (xr, yr), Pics(30), XOR
  482.      END IF
  483.     END SELECT
  484.    END IF
  485.   NEXT
  486.  
  487.   DO
  488.    FOR ctr = 1 TO NumbrBodies
  489.     'zero the forces
  490.     xf# = 0#: yf# = 0#: zf# = 0#
  491.     'recall position
  492.     xp# = Bodies(ctr).Xcoord
  493.     yp# = Bodies(ctr).Ycoord
  494.     zp# = Bodies(ctr).Zcoord
  495.  
  496. 'recall mass
  497.     m# = Bodies(ctr).Mass
  498.     FOR c2 = 1 TO NumbrBodies
  499.      IF c2 <> ctr THEN
  500.       m2# = Bodies(c2).Mass
  501.       distX# = xp# - Bodies(c2).Xcoord: distXX# = distX# * distX#
  502.       distY# = yp# - Bodies(c2).Ycoord: distYY# = distY# * distY#
  503.       distZ# = zp# - Bodies(c2).Zcoord: distZZ# = distZ# * distZ#
  504.       distsqd# = distXX# + distYY# + distZZ#
  505. ' work out force involved
  506.       IF distsqd# < 1 THEN EXIT DO
  507.       force# = -.01# * m# * m2# / distsqd#
  508.  
  509.       sqrtXY# = SQR(distXX# + distYY#)
  510.       sqrtYZ# = SQR(distYY# + distZZ#)
  511.       sqrtXZ# = SQR(distXX# + distZZ#)
  512.       IF sqrtXY# <> 0 THEN
  513.        zf# = zf# + force# * SIN(ATN(distZ# / sqrtXY#))
  514.       END IF
  515.       IF sqrtXZ# <> 0 THEN
  516.        yf# = yf# + force# * SIN(ATN(distY# / sqrtXZ#))
  517.       END IF
  518.       IF sqrtYZ# <> 0 THEN
  519.        xf# = xf# + force# * SIN(ATN(distX# / sqrtYZ#))
  520.       END IF
  521.      END IF
  522.     NEXT
  523.     Bodies(ctr).NewXVeloc = Bodies(ctr).XVeloc + xf# / m#
  524.     Bodies(ctr).NewYVeloc = Bodies(ctr).YVeloc + yf# / m#
  525.     Bodies(ctr).NewZVeloc = Bodies(ctr).ZVeloc + zf# / m#
  526.  
  527. 'work out new position
  528.     Bodies(ctr).NewXcoord = Bodies(ctr).Xcoord + Bodies(ctr).NewXVeloc
  529.     Bodies(ctr).NewYcoord = Bodies(ctr).Ycoord + Bodies(ctr).NewYVeloc
  530.     Bodies(ctr).NewZcoord = Bodies(ctr).Zcoord + Bodies(ctr).NewZVeloc
  531.    NEXT
  532.  
  533. '   undraw them
  534.  
  535.    track = track + 1
  536.    IF track > 9 THEN track = 0
  537.  
  538.    FOR ctr = 1 TO NumbrBodies
  539.     Xc = Bodies(ctr).Xcoord
  540.     Yc = Bodies(ctr).Ycoord
  541.     Zc = Bodies(ctr).Zcoord
  542.     GOSUB CalcView
  543.     xl = XviewLeft: xr = XviewRight: yl = YviewLeft: yr = YviewRight
  544.     ok = -1
  545.     IF xl < 0 THEN ok = 0
  546.     IF yl < 0 THEN ok = 0
  547.     IF xr < 0 THEN ok = 0
  548.     IF yr < 0 THEN ok = 0
  549.     IF ok THEN
  550.      SELECT CASE Bodies(ctr).Mass
  551.      CASE IS < 100
  552.       PUT (xl, yl), Pics(0), XOR
  553.      CASE IS < 10000
  554.       PUT (xl, yl), Pics(12), XOR
  555.      CASE ELSE
  556.       PUT (xl, yl), Pics(24), XOR
  557.      END SELECT
  558.      IF SGN(threedee) > 0 THEN
  559.       SELECT CASE Bodies(ctr).Mass
  560.       CASE IS < 100
  561.        PUT (xr, yr), Pics(6), XOR
  562.       CASE IS < 10000
  563.        PUT (xr, yr), Pics(18), XOR
  564.       CASE ELSE
  565.        PUT (xr, yr), Pics(30), XOR
  566.       END SELECT
  567.      END IF
  568.      IF track = 1 AND SGN(tracking) = 1 THEN
  569.       PUT (xl, yl), Pics(0), XOR
  570.       IF SGN(threedee) > 0 THEN
  571.        PUT (xr, yr), Pics(6), XOR
  572.       END IF
  573.      END IF
  574.     END IF
  575.  
  576.     Bodies(ctr).Xcoord = Bodies(ctr).NewXcoord
  577.     Bodies(ctr).Ycoord = Bodies(ctr).NewYcoord
  578.     Bodies(ctr).Zcoord = Bodies(ctr).NewZcoord
  579.     Bodies(ctr).XVeloc = Bodies(ctr).NewXVeloc
  580.     Bodies(ctr).YVeloc = Bodies(ctr).NewYVeloc
  581.     Bodies(ctr).ZVeloc = Bodies(ctr).NewZVeloc
  582.     Xc = Bodies(ctr).Xcoord
  583.     Yc = Bodies(ctr).Ycoord
  584.     Zc = Bodies(ctr).Zcoord
  585.     GOSUB CalcView
  586.     xl = XviewLeft: xr = XviewRight: yl = YviewLeft: yr = YviewRight
  587.     ok = -1
  588.     IF xl >= 0 OR yl >= 0 OR xr >= 0 OR yr >= 0 THEN
  589.      SELECT CASE Bodies(ctr).Mass
  590.      CASE IS < 100
  591.       PUT (xl, yl), Pics(0), XOR
  592.      CASE IS < 10000
  593.       PUT (xl, yl), Pics(12), XOR
  594.      CASE ELSE
  595.       PUT (xl, yl), Pics(24), XOR
  596.      END SELECT
  597.     END IF
  598.     IF SGN(threedee) > 0 THEN
  599.      SELECT CASE Bodies(ctr).Mass
  600.      CASE IS < 100
  601.       PUT (xr, yr), Pics(6), XOR
  602.      CASE IS < 10000
  603.       PUT (xr, yr), Pics(18), XOR
  604.      CASE ELSE
  605.       PUT (xr, yr), Pics(30), XOR
  606.      END SELECT
  607.     END IF
  608.  
  609.    NEXT
  610.  
  611. ' read a keystroke
  612.  
  613.   x$ = INKEY$
  614.   LOOP UNTIL LEN(x$) <> 0
  615.   IF LEN(x$) = 1 THEN
  616.    SELECT CASE ASC(x$)
  617.    CASE 27      'ESC
  618.     endprog = 1
  619.    END SELECT
  620.   ELSE
  621.    SELECT CASE ASC(RIGHT$(x$, 1))
  622.    CASE 59      'F1
  623.     tracking = -tracking
  624.    CASE 60      'F2
  625.     threedee = -threedee
  626.    END SELECT
  627.   END IF
  628.  
  629.  
  630. LOOP UNTIL endprog = 1
  631. END
  632.  
  633.  
  634. '  Mass,  Xcoord,Ycoord,Zcoord,   XVeloc,YVeloc,ZVeloc
  635. '    <NewXcoord,NewYcoord,NewZcoord,NewXVeloc,NewYVeloc,NewZVeloc>
  636. Bodyinfo:
  637.   DATA 3
  638.   'binary
  639.   DATA 1000000,   0, 300,   0, -2, 0,-4
  640.   DATA 1000000,   0,-300,   0,  2, 0,-4
  641.   DATA 1000000,   0,   0,   0,  0, 0, 8
  642.  
  643.  
  644.   DATA 100000 ,   0,   0,   0,  0, 0, 0
  645.   DATA 100    ,-400,   0,   0,  0, 0, 1
  646.   DATA 5000   ,-200,   0, 400,  0, 1, 0
  647.  
  648. END
  649.  
  650.  
  651. CalcView:
  652.   ok = -1
  653.   IF Xc < -500 THEN ok = 0
  654.   IF Yc < -500 THEN ok = 0
  655.   IF Zc < -700 THEN ok = 0
  656.   IF Xc > 500 THEN ok = 0
  657.   IF Yc > 500 THEN ok = 0
  658.   IF Zc > 700 THEN ok = 0
  659.   IF ok THEN
  660.     XviewLeft = 320 + (Xc \ 2) * ((Zc + 3000) / 4000) - (Zc \ 60)
  661.     XviewRight = XviewLeft + (Zc \ 30) + 1
  662.     YviewLeft = 200 - (Yc / 2.5) * ((Zc + 3500) / 4000) + (Zc \ 15)
  663.     YviewRight = YviewLeft - 1
  664.   ELSE
  665.     XviewLeft = -1
  666.     XviewRight = -1
  667.     YviewLeft = -1
  668.     YviewRight = -1
  669.   END IF
  670.   RETURN
  671.  
  672. '<->
  673. '<p>
  674. '++++++++++++++++++++++++
  675. SUB ziDragging
  676.  
  677.   IF Mouse AND MCursorVis THEN
  678.     SELECT CASE Response
  679.     CASE 2052 TO 2054
  680.       Regs.AX = 3
  681.       CALL zzBasicInt(&H33)
  682.       IF Regs.BX = Response - 2051 THEN
  683.     EXIT SUB
  684.       END IF
  685.     END SELECT
  686.   END IF
  687.   CALL ziExhaust
  688.  
  689. END SUB
  690.  
  691. '<p>
  692. '++++++++++++++++++++++++
  693. SUB ziDrawBank (FromButton, ToButton)
  694.  
  695.   CALL ziSetMCursorVis(10)
  696.  
  697.   FOR i = FromButton TO ToButton
  698.  
  699.     IF Bank(i).Active THEN
  700.  
  701.       IF Bank(i).State THEN
  702.     colour1 = 8
  703.       ELSE
  704.     colour1 = 15
  705.       END IF
  706.       colour2 = colour1 XOR 7
  707.  
  708.       Xcoord = Bank(i).Xloc
  709.       Ycoord = Bank(i).Yloc
  710.       XWidth = Bank(i).Wide
  711.       YDepth = Bank(i).Deep
  712.       X2Coord = Xcoord + XWidth
  713.  
  714.       IF YDepth THEN
  715.     IF YDepth = 1 THEN
  716.       Y2Coord = Ycoord + XWidth / XYratio!
  717.     ELSE
  718.       Y2Coord = Ycoord + YDepth
  719.     END IF
  720.     LINE (Xcoord, Ycoord)-(X2Coord - 1, Ycoord), colour1
  721.     LINE (Xcoord, Ycoord)-(Xcoord, Y2Coord - 1), colour1
  722.     LINE (Xcoord + 1, Y2Coord)-(X2Coord, Y2Coord), colour2
  723.     LINE (X2Coord, Ycoord)-(X2Coord, Y2Coord), colour2
  724.       ELSE
  725.     A = XWidth \ 2
  726.     B = A / XYratio!
  727.     c = Xcoord + A
  728.     D = Ycoord + B
  729.  
  730.     LINE (Xcoord, Ycoord)-(c + A, D + B), 7, BF
  731.  
  732.     CIRCLE (c, D), A, 8
  733.     CIRCLE (c, D), A - 1, 8
  734.     PAINT (c, D), 7, 7
  735.     IF Bank(i).State THEN
  736.       CIRCLE (c, D), XWidth \ 3, 8
  737.       PAINT (c, D), 8, 8
  738.     END IF
  739.       END IF
  740.     END IF
  741.  
  742.   NEXT
  743.  
  744.   CALL ziSetMCursorVis(11)
  745.  
  746. END SUB
  747.  
  748. '<p>
  749. '++++++++++++++++++++++++
  750. SUB ziExhaust
  751.  
  752.   DO
  753.     x$ = INKEY$
  754.   LOOP WHILE LEN(x$)
  755.  
  756.   IF Mouse AND MCursorVis THEN
  757.     DO
  758.       Regs.AX = 3
  759.       CALL zzBasicInt(&H33)
  760.     LOOP WHILE (Regs.BX AND 3)
  761.   END IF
  762.   Response = 0
  763. END SUB
  764.  
  765. '<p>
  766. '++++++++++++++++++++++++
  767. SUB ziLoadFont (Font$)
  768.  
  769.   DEF SEG = VARSEG(Font(0, 0))
  770.  
  771.   Module$ = Font$ + ".OVL"
  772.   CALL zzInPath(Module$)
  773.   IF Module$ = "" THEN
  774.     Module$ = Font$ + ".OVL"
  775.     ERROR 255
  776.   ELSE
  777.     BLOAD Module$, VARPTR(Font(0, 0))
  778.   END IF
  779.  
  780.   DEF SEG
  781.  
  782. END SUB
  783.  
  784. '<p>
  785. '++++++++++++++++++++++++
  786. SUB ziLocateMCursor (Xcoord, Ycoord)
  787.  
  788.   IF Mouse THEN
  789.     MXloc = Xcoord
  790.     MYloc = Ycoord
  791.     Regs.AX = 4
  792.     Regs.CX = Xcoord
  793.     Regs.DX = Ycoord
  794.     CALL zzBasicInt(&H33)
  795.     CALL ziSetMCursorVis(1)
  796.   END IF
  797.  
  798. END SUB
  799.  
  800. '<p>
  801. '++++++++++++++++++++++++
  802. SUB ziMouseOnButton (FromButton, ToButton)
  803.  
  804.   FoundButton = 0
  805.   FOR i = FromButton TO ToButton
  806.     IF Bank(i).Active THEN
  807.       IF Bank(i).Deep < 2 THEN
  808.     j = Bank(i).Wide / XYratio!
  809.       ELSE
  810.     j = Bank(i).Deep
  811.       END IF
  812.       IF MXloc > Bank(i).Xloc THEN
  813.     IF MXloc < Bank(i).Xloc + Bank(i).Wide THEN
  814.       IF MYloc > Bank(i).Yloc THEN
  815.         IF MYloc < Bank(i).Yloc + j THEN
  816.           FoundButton = i
  817.           EXIT SUB
  818.         END IF
  819.       END IF
  820.     END IF
  821.       END IF
  822.     ELSE
  823.       EXIT SUB
  824.     END IF
  825.   NEXT
  826.  
  827. END SUB
  828.  
  829. '<p>
  830. '++++++++++++++++++++++++
  831. SUB ziPublish (Printstring$, size, italic)
  832.  
  833.   CALL ziSetMCursorVis(10)
  834.  
  835.   xx = POINT(0)
  836.   yy = POINT(1)
  837.   IF size THEN
  838.     Scale = size
  839.   ELSE
  840.     Scale = 1
  841.   END IF
  842.  
  843.   LenString = LEN(Printstring$)
  844.  
  845.   ExpScale = 8 * Scale
  846.   limxx = xx + ExpScale * LenString - 1
  847.   limyy = yy + ExpScale - 1
  848.  
  849.   IF italic AND 1 THEN
  850.     limxx = limxx + 4 * Scale
  851.   END IF
  852.  
  853.  
  854.   IF italic AND 2 THEN
  855.   ELSE
  856.     LINE (xx, yy)-(limxx, limyy), bg, BF
  857.   END IF
  858.  
  859.  
  860.   FOR A = 0 TO LenString - 1
  861.     x = ASC(MID$(Printstring$, A + 1, 1))
  862.     B = xx + ExpScale * A
  863.     FOR y = 0 TO 7
  864.       c = Font(x, y)
  865.       D = y * Scale
  866.       e = yy + D
  867.       IF italic AND 1 THEN
  868.     f = B + 4 * Scale - (D + Scale - 1) \ 2 - 1
  869.       ELSE
  870.     f = B
  871.       END IF
  872.       g = 128
  873.       DO
  874.     IF c AND g THEN
  875.       FOR h = 0 TO Scale - 1
  876.         FOR i = 0 TO Scale - 1
  877.           PSET (f + h, e + i), fg
  878.         NEXT
  879.       NEXT
  880.     END IF
  881.     f = f + Scale
  882.     g = g \ 2
  883.       LOOP UNTIL g = 0
  884.     NEXT
  885.   NEXT
  886.   CALL zsLocateGCursor(limxx + 1, yy)
  887.  
  888.   CALL ziSetMCursorVis(11)
  889.  
  890. END SUB
  891.  
  892. '<p>
  893. '++++++++++++++++++++++++
  894. SUB ziPublishHere (row, col, Printstring$, size, italic)
  895.  
  896.  IF row + col > 0 THEN
  897.   LOCATE row, col
  898.  END IF
  899.  CALL zsAlignGCursor
  900.  CALL ziPublish(Printstring$, size, italic)
  901.  CALL zsAlignTCursor
  902.  
  903. END SUB
  904.  
  905. '<p>
  906. '++++++++++++++++++++++++
  907. SUB ziRadio (Button, FromButton, ToButton)
  908.  
  909.   IF Button >= FromButton THEN
  910.     IF Button <= ToButton THEN
  911.       FOR A = FromButton TO ToButton
  912.     Bank(A).State = 0
  913.       NEXT
  914.     END IF
  915.   END IF
  916.  
  917.   Bank(Button).State = 1
  918.   CALL ziDrawBank(FromButton, ToButton)
  919.  
  920. END SUB
  921.  
  922. '<p>
  923. '++++++++++++++++++++++++
  924. SUB ziReadField (Min, Max, Permitted$)
  925.  
  926.   CALL ziSetMCursorVis(10)
  927.  
  928.   atRow = CSRLIN
  929.   atCol = POS(x)
  930.   Field$ = ""
  931.   PRINT CHR$(219); SPACE$(Max);
  932.   Rules$ = UCASE$(Permitted$)
  933.  
  934.   brake = 1
  935.   WHILE brake
  936.     x$ = ""
  937.     WHILE LEN(x$) = 0
  938.       x$ = INKEY$
  939.     WEND
  940.     IF INSTR(Rules$, "C") THEN x$ = UCASE$(x$)
  941.     oldLen = LEN(Field$)
  942.     Good = 0
  943.     IF INSTR(Rules$, ".") THEN
  944.       IF x$ = "." THEN
  945.     IF INSTR(Field$, ".") = 0 THEN
  946.       Good = 1
  947.     END IF
  948.       END IF
  949.     END IF
  950.     IF INSTR(Rules$, "N") THEN
  951.       IF INSTR("0123456789", x$) THEN
  952.     Good = 1
  953.       END IF
  954.     END IF
  955.     IF INSTR(Rules$, "S") THEN
  956.       IF x$ = " " THEN
  957.     Good = 1
  958.       END IF
  959.     END IF
  960.     IF INSTR(Rules$, "X") THEN
  961.       IF INSTR("ABCDEFGHIJKLMNOPQRSTUVWXYZ", UCASE$(x$)) THEN
  962.     Good = 1
  963.       END IF
  964.     END IF
  965.     IF INSTR(Rules$, "Y") THEN
  966.       IF INSTR("YyNy", x$) THEN
  967.     Good = 1
  968.       END IF
  969.     END IF
  970.     IF Good THEN
  971.       Field$ = Field$ + x$
  972.       IF INSTR(Field$, ".") THEN
  973.     NewMax = Max + 1
  974.       ELSE
  975.     NewMax = Max
  976.       END IF
  977.       Field$ = MID$(Field$, 1, NewMax)
  978.     END IF
  979.  
  980.     ' handle Bkspace
  981.     IF ASC(x$) = 8 AND LEN(Field$) THEN
  982.       Field$ = MID$(Field$, 1, LEN(Field$) - 1)
  983.     END IF
  984.  
  985.     Signif$ = Field$ + "X"
  986.     WHILE INSTR(" 0", MID$(Signif$, 1, 1))
  987.       Signif$ = MID$(Signif$, 2)
  988.     WEND
  989.     IF INSTR(Signif$, ".") THEN
  990.       SignifLen = LEN(Signif$) - 2
  991.     ELSE
  992.       SignifLen = LEN(Signif$) - 1
  993.     END IF
  994.  
  995.     ' handle Enter
  996.     IF ASC(x$) = 13 AND SignifLen >= Min THEN
  997.       oldLen = LEN(Field$) + 1
  998.       brake = 0
  999.     END IF
  1000.  
  1001.     ' handle Esc
  1002.     IF ASC(x$) = 27 THEN
  1003.       LOCATE atRow, atCol
  1004.       PRINT CHR$(219); SPACE$(Max);
  1005.       Field$ = ""
  1006.       IF INSTR(Rules$, "E") THEN
  1007.     EXIT SUB
  1008.       END IF
  1009.     END IF
  1010.  
  1011.     ' reprint if change, or beep if no change
  1012.     IF oldLen = LEN(Field$) THEN
  1013.       BEEP
  1014.     ELSE
  1015.       LOCATE atRow, atCol
  1016.       IF INSTR(Rules$, "P") THEN
  1017.     PRINT STRING$(LEN(Field$), 254); CHR$(219); " ";
  1018.       ELSE
  1019.     PRINT Field$; CHR$(219); " ";
  1020.       END IF
  1021.     END IF
  1022.  
  1023.     ' check for auto-Enter
  1024.     IF INSTR(Rules$, "A") THEN
  1025.       IF SignifLen = Max THEN
  1026.     brake = 0
  1027.       END IF
  1028.     END IF
  1029.   WEND
  1030.  
  1031.   ' justify if required
  1032.   IF INSTR(Rules$, "J") THEN
  1033.     WHILE MID$(Field$, 1, 1) = "0"
  1034.       Field$ = MID$(Field$, 2)
  1035.     WEND
  1036.     Field$ = RIGHT$(SPACE$(NewMax) + Field$, NewMax)
  1037.   END IF
  1038.  
  1039.   ' reprint, deleting the cursor
  1040.   LOCATE atRow, atCol
  1041.   IF INSTR(Rules$, "P") THEN
  1042.     PRINT STRING$(LEN(Field$), 254); " ";
  1043.   ELSE
  1044.     PRINT Field$; " ";
  1045.   END IF
  1046.  
  1047.   CALL ziSetMCursorVis(11)
  1048.  
  1049. END SUB
  1050.  
  1051. '<p>
  1052. '++++++++++++++++++++++++
  1053. SUB ziSetMCursorVis (Status) STATIC
  1054.  
  1055.   IF Mouse THEN
  1056.     SELECT CASE Status
  1057.     CASE 0
  1058.       IF MCursorVis THEN
  1059.        Regs.AX = 2
  1060.        CALL zzBasicInt(&H33)
  1061.       END IF
  1062.     CASE 1
  1063.       Regs.AX = 1
  1064.       CALL zzBasicInt(&H33)
  1065.     CASE 10
  1066.       Regs.AX = &H2A
  1067.       CALL zzBasicInt(&H33)
  1068.       IF Regs.AX = 0 THEN
  1069.     TempFlag = 1
  1070.     Regs.AX = 2
  1071.     CALL zzBasicInt(&H33)
  1072.       ELSE
  1073.     TempFlag = 0
  1074.       END IF
  1075.     CASE 11
  1076.       IF TempFlag THEN
  1077.     Regs.AX = 1
  1078.     CALL zzBasicInt(&H33)
  1079.       END IF
  1080.     END SELECT
  1081.     Regs.AX = &H2A
  1082.     CALL zzBasicInt(&H33)
  1083.     IF Regs.AX = 0 THEN
  1084.       MCursorVis = 1
  1085.     ELSE
  1086.       MCursorVis = 0
  1087.     END IF
  1088.   END IF
  1089. END SUB
  1090.  
  1091. '<p>
  1092. '++++++++++++++++++++++++
  1093. SUB ziWander (Timeout!)
  1094.  
  1095.   IF Timeout! = 0 THEN
  1096.     WatchFor! = TIMER + 3600
  1097.   ELSE
  1098.     WatchFor! = TIMER + Timeout!
  1099.   END IF
  1100.  
  1101.   Response = 0
  1102.  
  1103.   DO
  1104.     x$ = INKEY$
  1105.     IF LEN(x$) THEN
  1106.       SELECT CASE LEN(x$)
  1107.       CASE 1
  1108.     A = INSTR(Allowed$, x$)
  1109.     IF A THEN
  1110.       Response = A
  1111.       EXIT DO
  1112.     END IF
  1113.     SELECT CASE ASC(x$)
  1114.     CASE 8: Response = 261
  1115.     CASE 9: Response = 266
  1116.     CASE 10: Response = 512
  1117.     CASE 13: Response = 256
  1118.     CASE 27: Response = 267
  1119.     CASE 127: Response = 517
  1120.     END SELECT
  1121.     IF Response THEN
  1122.       EXIT DO
  1123.     END IF
  1124.       CASE 2
  1125.     Rightmost = ASC(RIGHT$(x$, 1))
  1126.     SELECT CASE Rightmost
  1127.     CASE 15: Response = 1019
  1128.     CASE 59 TO 68
  1129.       Response = 4038
  1130.     CASE 72: Response = 187
  1131.     CASE 71 TO 73
  1132.       Response = 191
  1133.     CASE 75: Response = 182
  1134.     CASE 77: Response = 181
  1135.     CASE 80: Response = 180
  1136.     CASE 79 TO 81
  1137.       Response = 184
  1138.     CASE 84 TO 93
  1139.       Response = 16301
  1140.     CASE 94 TO 103
  1141.       Response = 8099
  1142.     CASE 115 TO 116
  1143.       Response = 398
  1144.     CASE 117: Response = 402
  1145.     CASE 118: Response = 403
  1146.     CASE 119: Response = 399
  1147.     CASE 127: Response = 390
  1148.     CASE 132: Response = 388
  1149.     CASE 133 TO 134
  1150.       Response = 3974
  1151.     CASE 135 TO 136
  1152.       Response = 16260
  1153.     CASE 137 TO 138
  1154.       Response = 8066
  1155.     END SELECT
  1156.     IF Response THEN
  1157.       Response = Response + Rightmost
  1158.       EXIT DO
  1159.     END IF
  1160.       END SELECT
  1161.     END IF
  1162.  
  1163.     IF Mouse AND MCursorVis THEN
  1164.       Regs.AX = 3
  1165.       CALL zzBasicInt(&H33)
  1166.       SELECT CASE Regs.BX
  1167.       CASE 1 TO 3
  1168.     Response = 2048 + Regs.BX
  1169.     nowtime! = TIMER
  1170.     DO
  1171.       Regs.AX = 3
  1172.       CALL zzBasicInt(&H33)
  1173.       IF Regs.BX = 0 THEN EXIT DO
  1174.     LOOP UNTIL TIMER - nowtime! > .3
  1175.     IF Regs.BX = Response - 2048 THEN
  1176.       Response = Response + 3
  1177.     ELSE
  1178.       IF Regs.BX = 0 AND Response = 2049 AND DClick THEN
  1179.         nowtime! = TIMER
  1180.         DO
  1181.           Regs.AX = 3
  1182.           CALL zzBasicInt(&H33)
  1183.           IF Regs.BX = 1 THEN EXIT DO
  1184.         LOOP UNTIL TIMER - nowtime! > .3
  1185.         IF Regs.BX = 1 THEN
  1186.           Response = 2048
  1187.           CALL ziExhaust
  1188.         END IF
  1189.       END IF
  1190.       IF Regs.BX = 3 THEN
  1191.         Response = 2051
  1192.       END IF
  1193.     END IF
  1194.       END SELECT
  1195.       IF Response THEN
  1196.     MXloc = Regs.CX
  1197.     MYloc = Regs.DX
  1198.     EXIT DO
  1199.       END IF
  1200.     END IF
  1201.  
  1202.   LOOP UNTIL WatchFor! < TIMER
  1203.   HResponse = Response \ 256
  1204.   LResponse = Response MOD 256
  1205.  
  1206. END SUB
  1207.  
  1208. '<p>
  1209. '++++++++++++++++++++++++
  1210. SUB zsAlignGCursor
  1211.  
  1212.   row = CSRLIN
  1213.   col = POS(0)
  1214.   GXloc = (col - 1) * ((Xmax + 1) \ Cols)
  1215.   GYloc = (row - 1) * ((((Ymax + 1) \ Rows) * Rows + 1) \ Rows)
  1216.   CALL zsLocateGCursor(GXloc, GYloc)
  1217.  
  1218. END SUB
  1219.  
  1220. '<p>
  1221. '++++++++++++++++++++++++
  1222. SUB zsAlignTCursor
  1223.  
  1224.   GXloc = POINT(0)
  1225.   GYloc = POINT(1)
  1226.   A = (Xmax + 1) / Cols
  1227.   B = (Ymax + 1) / Rows
  1228.   col = (GXloc + A - 1) \ A + 1
  1229.   row = (GYloc + B - 1) \ B + 1
  1230.   LOCATE row, col
  1231.   CALL zsAlignGCursor
  1232.  
  1233. END SUB
  1234.  
  1235. '<p>
  1236. '++++++++++++++++++++++++
  1237. SUB zsLocateGCursor (Xcoord, Ycoord)
  1238.  
  1239.   GXloc = Xcoord
  1240.   GYloc = Ycoord
  1241.   PSET (GXloc, GYloc), POINT(GXloc, GYloc)
  1242.  
  1243. END SUB
  1244.  
  1245. '<p>
  1246. '++++++++++++++++++++++++
  1247. SUB zsPastel (Xcoord, Ycoord, Wide, Deep, colour1, colour2)
  1248.  
  1249.   CALL ziSetMCursorVis(10)
  1250.  
  1251.   IF Deep < 2 THEN
  1252.     A = Wide / XYratio!
  1253.   ELSE
  1254.     A = Deep
  1255.   END IF
  1256.  
  1257.   LINE (Xcoord, Ycoord)-(Xcoord + Wide - 1, Ycoord + A - 1), colour1, BF
  1258.   FOR B = Xcoord TO Xcoord + Wide - 1 STEP 2
  1259.     LINE (B, Ycoord)-(B, Ycoord + A - 1), colour2, , &H5555
  1260.   NEXT
  1261.   FOR B = Xcoord + 1 TO Xcoord + Wide - 1 STEP 2
  1262.     LINE (B, Ycoord)-(B, Ycoord + A - 1), colour2, , &HAAAA
  1263.   NEXT
  1264.  
  1265.   CALL ziSetMCursorVis(11)
  1266.  
  1267. END SUB
  1268.  
  1269. '<p>
  1270. '++++++++++++++++++++++++
  1271. SUB zsSetScrnMode (Mode, HiRows, HiCols)
  1272.  
  1273.   CALL ziSetMCursorVis(10)
  1274.  
  1275.   ScrnMode = Mode
  1276.   SELECT CASE Mode
  1277.   CASE 9
  1278.     SCREEN 9
  1279.     IF HiRows THEN
  1280.       Rows = 43
  1281.     ELSE
  1282.       Rows = 25
  1283.     END IF
  1284.     Xmax = 639
  1285.     Ymax = 349
  1286.   CASE 12
  1287.     SCREEN 12
  1288.     IF HiRows THEN
  1289.       Rows = 60
  1290.     ELSE
  1291.       Rows = 30
  1292.     END IF
  1293.     Xmax = 639
  1294.     Ymax = 479
  1295.   CASE 13
  1296.     SCREEN 13
  1297.     Rows = 25
  1298.     Cols = 40
  1299.     Xmax = 319
  1300.     Ymax = 199
  1301.   CASE ELSE
  1302.     RETURN
  1303.   END SELECT
  1304.  
  1305.   IF Mode <> 13 THEN
  1306.     IF HiCols THEN
  1307.       Cols = 80
  1308.     ELSE
  1309.       Cols = 40
  1310.     END IF
  1311.   END IF
  1312.   WIDTH Cols, Rows
  1313.   CLS
  1314.   SELECT CASE Mode
  1315.   CASE 9
  1316.     COLOR fg, 0
  1317.   CASE ELSE
  1318.     COLOR fg
  1319.   END SELECT
  1320.  
  1321.   LINE (0, 0)-(Xmax, Ymax), bg, BF
  1322.   LOCATE 1, 1, 0
  1323.   PSET (0, 0), bg
  1324.   XYratio! = .75 * (Xmax + 1) / (Ymax + 1)
  1325.  
  1326.   CALL ziSetMCursorVis(11)
  1327.  
  1328. END SUB
  1329.  
  1330. '<p>
  1331. '++++++++++++++++++++++++
  1332. SUB zsSubstitute (Xcoord, Ycoord, Wide, Deep, colour1, colour2)
  1333.  
  1334.   CALL ziSetMCursorVis(10)
  1335.  
  1336.   IF Deep < 2 THEN
  1337.     A = Wide / XYratio!
  1338.   ELSE
  1339.     A = Deep
  1340.   END IF
  1341.   FOR B = Xcoord TO Xcoord + Wide - 1
  1342.     FOR c = Ycoord TO Ycoord + A - 1
  1343.       IF POINT(B, c) = colour1 THEN
  1344.     PSET (B, c), colour2
  1345.       END IF
  1346.     NEXT
  1347.   NEXT
  1348.  
  1349.   CALL ziSetMCursorVis(11)
  1350.  
  1351. END SUB
  1352.  
  1353. '<p>
  1354. '++++++++++++++++++++++++
  1355. SUB zzAlphaSort (SortData$())
  1356.  
  1357.  DIM SortPointers(SortCount, 2)
  1358.  
  1359.  FOR i = 2 TO SortCount
  1360.   j = 1
  1361.  
  1362.   DO
  1363.    k = j
  1364.    IF SortData$(i) < SortData$(j) THEN
  1365.     j = SortPointers(j, 1)
  1366.    ELSE
  1367.     j = SortPointers(j, 2)
  1368.    END IF
  1369.   LOOP WHILE j <> 0
  1370.  
  1371.   IF SortData$(i) < SortData$(k) THEN
  1372.    SortPointers(k, 1) = i
  1373.   ELSE
  1374.    SortPointers(k, 2) = i
  1375.   END IF
  1376.  NEXT
  1377.  
  1378.  SortPointers(0, 1) = 1
  1379.  
  1380.  
  1381.  FOR i = 1 TO SortCount
  1382.   j = 0
  1383.   DO WHILE SortPointers(j, 1) <> 0
  1384.    k = j
  1385.    j = SortPointers(j, 1)
  1386.   LOOP
  1387.   SortPointers(k, 1) = SortPointers(j, 2)
  1388.  
  1389.   SWAP SortData$(i), SortData$(j)
  1390.   SWAP SortPointers(i, 1), SortPointers(j, 1)
  1391.   SWAP SortPointers(i, 2), SortPointers(j, 2)
  1392.  
  1393.   FOR k = 0 TO SortCount
  1394.    FOR l = 1 TO 2
  1395.     IF SortPointers(k, l) = i THEN SortPointers(k, l) = j
  1396.    NEXT
  1397.   NEXT
  1398.  NEXT
  1399.  
  1400. END SUB
  1401.  
  1402. '<p>
  1403. '++++++++++++++++++++++++
  1404. SUB zzBasicInt (IntType) STATIC
  1405.  
  1406.   DIM ASM(54)
  1407.   DEF SEG = VARSEG(ASM(0))
  1408.  
  1409.   IF ASM(1) = 0 THEN
  1410.     Module$ = "BASICINT.OVL"
  1411.     CALL zzInPath(Module$)
  1412.     IF Module$ = "" THEN
  1413.       Module$ = "BASICINT.OVL"
  1414.       ERROR 255
  1415.     ELSE
  1416.       BLOAD Module$, VARPTR(ASM(0))
  1417.     END IF
  1418.   END IF
  1419.  
  1420.   CALL ABSOLUTE(Regs, IntType, VARPTR(ASM(0)))
  1421.  
  1422.   DEF SEG
  1423.  
  1424. END SUB
  1425.  
  1426. '<p>
  1427. '++++++++++++++++++++++++
  1428. SUB zzChangeDir (Directory$)
  1429.  DIM str AS STRING * 65
  1430.  
  1431.  str = LTRIM$(RTRIM$(UCASE$(Directory$))) + CHR$(0)
  1432.  IF MID$(str, 2, 1) = ":" THEN
  1433.   curdrive$ = MID$(str, 1, 1)
  1434.   str = MID$(str, 3)
  1435.  ELSE
  1436.   Regs.AX = &H1900
  1437.   CALL zzBasicInt(&H21)
  1438.   curdrive$ = CHR$(65 + (Regs.AX AND 255))
  1439.  END IF
  1440.  IF MID$(str, 1, 1) = CHR$(0) THEN
  1441.   GOSUB zzChangeDirAA
  1442.   EXIT SUB
  1443.  END IF
  1444.  str = curdrive$ + ":" + str
  1445.  Regs.AX = &H3B00
  1446.  Regs.DS = VARSEG(str)
  1447.  Regs.DX = VARPTR(str)
  1448.  CALL zzBasicInt(&H21)
  1449.  IF (Regs.FL AND 256) = 256 THEN
  1450.   Directory$ = ""
  1451.  ELSE
  1452.   GOSUB zzChangeDirAA
  1453.  END IF
  1454.  EXIT SUB
  1455.  
  1456. zzChangeDirAA:
  1457.   Regs.AX = &H4700
  1458.   Regs.DX = ASC(curdrive$) - 64
  1459.   Regs.DS = VARSEG(str)
  1460.   Regs.SI = VARPTR(str)
  1461.   CALL zzBasicInt(&H21)
  1462.   i = INSTR(str, CHR$(0))
  1463.   Directory$ = curdrive$ + ":\" + MID$(str, 1, i - 1)
  1464.   RETURN
  1465. END SUB
  1466.  
  1467. '<p>
  1468. '++++++++++++++++++++++++
  1469. SUB zzChangeDrive (Drive$)
  1470.  
  1471.  CALL zzCritOff
  1472.  GOSUB zzChangeDriveProcess
  1473.  CALL zzCritOn
  1474.  
  1475.  EXIT SUB
  1476.  
  1477. zzChangeDriveProcess:
  1478.  
  1479.  Drive$ = LTRIM$(RTRIM$(UCASE$(Drive$)))
  1480.  IF LEN(Drive$) = 0 THEN
  1481.   Regs.AX = &H1900
  1482.   CALL zzBasicInt(&H21)
  1483.   Drive$ = CHR$(65 + (Regs.AX AND 255)) + ":"
  1484.   RETURN
  1485.  END IF
  1486.  
  1487.  IF LEN(Drive$) = 1 THEN Drive$ = Drive$ + ":"
  1488.  IF LEN(Drive$) > 2 THEN Drive$ = "?"
  1489.  
  1490.  IF MID$(Drive$, 2, 1) = ":" THEN
  1491.   drv = ASC(Drive$)
  1492.   Drive$ = "?"
  1493.   IF drv < 65 THEN RETURN
  1494.   IF drv > 90 THEN RETURN
  1495.   drv = drv - 65
  1496.  
  1497. ' establish whether this is a shared drive
  1498.  
  1499.   Regs.AX = &H440E
  1500.   Regs.BX = drv + 1
  1501.   CALL zzBasicInt(&H21)
  1502.   IF (Regs.FL AND 256) = 256 THEN
  1503.    Regs.AX = 0
  1504.   END IF
  1505.   Regs.AX = Regs.AX AND 255
  1506.   IF Regs.AX <> 0 THEN
  1507.    IF Regs.AX <> drv + 1 THEN
  1508.     drv = Regs.AX - 1
  1509.    END IF
  1510.   END IF
  1511.  
  1512. ' establish whether this is a valid drive
  1513.  
  1514.   Regs.AX = &H1C00
  1515.   Regs.DX = drv + 1
  1516.   CALL zzBasicInt(&H21)
  1517.   IF (Regs.AX AND 255) = 255 THEN RETURN
  1518.  
  1519. ' now change to it
  1520.  
  1521.   Regs.AX = &HE00
  1522.   Regs.DX = drv
  1523.   CALL zzBasicInt(&H21)
  1524.  
  1525.   Drive$ = CHR$(65 + drv) + ":"
  1526.  
  1527.  
  1528.  ELSE
  1529.   Drive$ = "?"
  1530.  END IF
  1531.  RETURN
  1532.  
  1533. END SUB
  1534.  
  1535. SUB zzCritOff
  1536.  
  1537.  Regs.AX = &H2524
  1538.  Regs.DS = VARSEG(IRET)
  1539.  Regs.DX = VARPTR(IRET)
  1540.  CALL zzBasicInt(&H21)
  1541.  CritCount = CritCount + 1
  1542.  
  1543. END SUB
  1544.  
  1545. SUB zzCritOn
  1546.  
  1547.  CritCount = CritCount - 1
  1548.  IF CritCount = 0 THEN
  1549.   Regs.AX = &H2524
  1550.   Regs.DS = CritSeg
  1551.   Regs.DX = CritPtr
  1552.   CALL zzBasicInt(&H21)
  1553.  END IF
  1554.  
  1555. END SUB
  1556.  
  1557. '<p>
  1558. '++++++++++++++++++++++++
  1559. SUB zzFileSelectBox (Pattern$)
  1560.  
  1561. DIM Devices(26)  ';valid devices have a non-zero value
  1562. DIM validDevs(27)
  1563.  
  1564. DIM parts$(11) ';ten deep is allowed
  1565. DIM Dirs$(200) ';lots of subdirectories
  1566. DIM Files$(200) ';lots of files
  1567. DIM str AS STRING * 65
  1568.  
  1569.  CALL zzCritOff
  1570.  GOSUB zzFileSelectBoxProcess
  1571.  CALL zzCritOn
  1572.  
  1573.  EXIT SUB
  1574.  
  1575. zzFileSelectBoxProcess:
  1576.  
  1577. ' create the screen
  1578.  
  1579.   IF screendone = 0 THEN
  1580.    bg = 7: fg = 15
  1581.    CALL zsSetScrnMode(9, 1, 1)
  1582.    fg = 0
  1583.    CALL ziPublishHere(3, 34, "Select a File", 1, 3)
  1584.    Stuff$ = "(Please Wait)"
  1585.    fg = 14
  1586.    GOSUB zzFileSelectBoxDD
  1587.  
  1588. ' print the headers
  1589.  
  1590.    fg = 8
  1591.    CALL ziPublishHere(42, 17, "Use left & right arrow keys to change columns", 0, 1)
  1592.   END IF
  1593.   screendone = 1
  1594.  
  1595.   fg = 8: CALL ziPublishHere(8, 2, "Drives", 2, 1): fg = 0
  1596.   LINE (10, 7)-(Xmax - 10, Ymax - 7), 4, B
  1597.  
  1598.  
  1599.   IF NoDriveSelection = 0 THEN
  1600.    dev = 0: GOSUB zzFileSelectBoxAA
  1601.  
  1602. ' find the DTA
  1603.  
  1604.    Regs.AX = &H2F00
  1605.    CALL zzBasicInt(&H21)
  1606.    DTAseg = Regs.ES
  1607.    DTAptr = Regs.BX
  1608.  
  1609. ' establish the existing devices
  1610.  
  1611.    MaxDevs = 0
  1612.    FOR i = 1 TO 26
  1613.     Devices(i) = 0
  1614.     validDevs(i) = 0
  1615.     Regs.AX = &H440E
  1616.     Regs.BX = i
  1617.     CALL zzBasicInt(&H21)
  1618.     IF (Regs.FL AND 256) = 256 THEN
  1619.      Regs.AX = 0
  1620.     END IF
  1621.     Regs.AX = Regs.AX AND 255
  1622.     IF (Regs.AX = 0) OR (Regs.AX = i) THEN
  1623.      Regs.AX = &H1C00
  1624.      Regs.DX = i
  1625.      CALL zzBasicInt(&H21)
  1626.      IF (Regs.AX AND 255) <> 255 THEN
  1627.       MaxDevs = MaxDevs + 1
  1628.       Devices(i) = MaxDevs '; set the crossreference
  1629.       validDevs(MaxDevs) = i
  1630.      END IF
  1631.     END IF
  1632.    NEXT
  1633.  
  1634. ' print the valid drives as a list
  1635.  
  1636.    fg = 0
  1637.    FOR i = 1 TO MaxDevs
  1638.     x$ = CHR$(64 + validDevs(i)) + ":"
  1639.     CALL ziPublishHere(10 + i + i, 7, x$, 1, 0)
  1640.    NEXT
  1641.   END IF
  1642.   LINE (GXloc - 16, GYloc + 8)-(GXloc, 319), 7, BF 'clear rest of list
  1643.  
  1644.  
  1645.   NoDriveSelection = 0
  1646.  
  1647.   fg = 8: CALL ziPublishHere(8, 20, "Tree", 2, 1): fg = 0
  1648.   LINE (10, 7)-(Xmax - 10, Ymax - 7), 4, B
  1649.  
  1650. ' carve off any 'wildcard' from the specified input parameter
  1651.  
  1652.   Pattern$ = UCASE$(LTRIM$(RTRIM$(Pattern$)))
  1653.   str = Pattern$
  1654.   IF INSTR(str, "?") + INSTR(str, "*") = 0 THEN
  1655.    base$ = Pattern$
  1656.    wild$ = "*.*"
  1657.   ELSE
  1658.    IF MID$(str, 2, 1) = ":" THEN
  1659.     start = 3
  1660.    ELSE
  1661.     start = 1
  1662.    END IF
  1663.    DO
  1664.     i = INSTR(start, str, "\")
  1665.     IF i <> 0 THEN
  1666.      start = i + 1
  1667.     END IF
  1668.    LOOP UNTIL i = 0
  1669.    base$ = MID$(str, 1, start - 1)
  1670.    wild$ = MID$(RTRIM$(str), start)
  1671.   END IF
  1672.  
  1673.   CALL zzValidate(base$)
  1674.   IF base$ = "?" THEN
  1675.    base$ = ""
  1676.    CALL zzChangeDir(base$)
  1677.   END IF
  1678.  
  1679.  
  1680.   IF MID$(base$, LEN(base$)) = "\" THEN
  1681.    basex$ = MID$(base$, 1, LEN(base$) - 1)
  1682.   ELSE
  1683.    basex$ = base$
  1684.   END IF
  1685.  
  1686.  
  1687.  
  1688. ' validate the "wildcard" portion
  1689.  
  1690. ' (make sure no more than one ".")
  1691.  
  1692.   i = INSTR(wild$, ".")
  1693.   IF i <> 0 THEN
  1694.    x$ = wild$
  1695.    MID$(x$, i, 1) = "+"
  1696.    IF INSTR(x$, ".") THEN
  1697.     wild$ = "*.*"
  1698.     i = 2
  1699.    END IF
  1700.   END IF
  1701.  
  1702. ' (divide it into its two component parts)
  1703.  
  1704.   IF i < 2 THEN
  1705.    wildl$ = wild$
  1706.    wildr$ = ""
  1707.   ELSE
  1708.    wildl$ = MID$(wild$, 1, i - 1)
  1709.    wildr$ = MID$(wild$, i + 1)
  1710.   END IF
  1711.   IF LEN(wildl$) > 8 OR LEN(wildr$) > 3 THEN
  1712.    wild$ = "*.*"
  1713.    wildl$ = "*"
  1714.    wildr$ = "*"
  1715.   END IF
  1716.  
  1717. ' (make sure no more than one TRAILING "*" in left part)
  1718.  
  1719.   i = INSTR(wildl$, "*")
  1720.   IF i <> 0 THEN
  1721.    IF i <> LEN(wildl$) THEN
  1722.     wild$ = "*.*"
  1723.     wildl$ = "*"
  1724.     wildr$ = "*"
  1725.    END IF
  1726.   END IF
  1727.  
  1728. ' (make sure no more than one TRAILING "*" in right part)
  1729.  
  1730.   i = INSTR(wildr$, "*")
  1731.   IF i <> 0 THEN
  1732.    IF i <> LEN(wildr$) THEN
  1733.     wild$ = "*.*"
  1734.     wildl$ = "*"
  1735.     wildr$ = "*"
  1736.    END IF
  1737.   END IF
  1738.  
  1739.   i = 39 - LEN(wild$) \ 2
  1740.   x$ = "[" + wild$ + "]"
  1741.   CALL ziPublishHere(7, i, x$, 0, 0)
  1742.  
  1743. ' determine the specified drive
  1744.  
  1745.   dev = Devices(ASC(base$) - 64)
  1746.   GOSUB zzFileSelectBoxAA
  1747.  
  1748. ' create the tree
  1749.  
  1750.   FOR i = 0 TO 11
  1751.    parts$(i) = ""
  1752.   NEXT
  1753.   x$ = basex$ + "\"
  1754.  
  1755.   levels = 0
  1756.   DO
  1757.    i = INSTR(x$, "\")
  1758.    IF i <> 0 THEN
  1759.     parts$(levels) = MID$(x$, 1, i - 1)
  1760.     levels = levels + 1
  1761.     x$ = MID$(x$, i + 1)
  1762.    END IF
  1763.   LOOP UNTIL i = 0
  1764.   parts$(0) = parts$(0) + "\"
  1765.   levels = levels - 1
  1766.  
  1767.   CALL ziPublishHere(12, 15, parts$(0), 0, 0)
  1768.  
  1769.   IF levels > 0 THEN
  1770.    FOR i = 1 TO levels
  1771.     x$ = SPACE$(i + i) + CHR$(179)
  1772.     CALL ziPublishHere(11 + i + i, 13, x$, 0, 0)
  1773.     x$ = SPACE$(i + i) + CHR$(192) + CHR$(196) + parts$(i)
  1774.     CALL ziPublishHere(12 + i + i, 13, x$, 0, 0)
  1775.    NEXT
  1776.   END IF
  1777.  
  1778.   oldtree = 255
  1779.   tree = levels
  1780.   GOSUB zzFileSelectBoxHH
  1781.  
  1782.  
  1783. ' test for subdirectories present
  1784.  
  1785.   olddline = 0
  1786.   x$ = basex$ + "\*.*"
  1787.   CALL zzSearchD(x$)
  1788.  
  1789.   IF Directories <> 0 THEN
  1790.    fg = 8: CALL ziPublishHere(8, 64, "Subdirs", 2, 1): fg = 0
  1791.    FromDir = 1
  1792.    GOSUB zzFileSelectBoxEE
  1793.   END IF
  1794.  
  1795. ' test for files present
  1796.  
  1797.   x$ = basex$ + "\" + wild$
  1798.   CALL zzSearchF(x$)
  1799.  
  1800.   IF FileNames <> 0 THEN
  1801.    fg = 8: CALL ziPublishHere(8, 51, "Files", 2, 1): fg = 0
  1802.    FromFile = 1
  1803.    GOSUB zzFileSelectBoxFF
  1804.   END IF
  1805.  
  1806. ' determine where to start
  1807.  
  1808.   IF FileNames = 0 THEN
  1809.    IF Directories = 0 THEN
  1810.     fg = 4: CALL ziPublishHere(8, 20, "Tree", 2, 1): fg = 0
  1811.     Stuff$ = basex$ + "\"
  1812.     GOSUB zzFileSelectBoxDD
  1813.     Column = 2
  1814.    ELSE
  1815.     fg = 4: CALL ziPublishHere(8, 64, "Subdirs", 2, 1): fg = 0
  1816.     dline = 1
  1817.     GOSUB zzFileSelectBoxBB
  1818.     Stuff$ = basex$ + "\" + Directories$(FromDir)
  1819.     GOSUB zzFileSelectBoxDD
  1820.     Column = 4
  1821.    END IF
  1822.  
  1823.   ELSE
  1824.    fg = 4: CALL ziPublishHere(8, 51, "Files", 2, 1): fg = 0
  1825.    fline = 1
  1826.    GOSUB zzFileSelectBoxCC
  1827.    Column = 3
  1828.   END IF
  1829.  
  1830.  
  1831. ' determine what to do, based on keystroke
  1832.  
  1833.   DO
  1834.    stroke$ = "X"
  1835.    DO
  1836.     stroke$ = INKEY$
  1837.    LOOP UNTIL LEN(stroke$) = 0
  1838.    DO
  1839.     stroke$ = INKEY$
  1840.    LOOP WHILE LEN(stroke$) = 0
  1841.    IF LEN(stroke$) = 1 THEN
  1842.     stroke$ = UCASE$(stroke$)
  1843.     SELECT CASE ASC(stroke$)
  1844.     CASE 27   'ESC
  1845.      Pattern$ = "?"
  1846.      RETURN
  1847.     CASE 13   'Enter
  1848.      SELECT CASE Column
  1849.      CASE 1    'enactivate new drive
  1850.       x$ = CHR$(validDevs(dev) + 64) + ":"
  1851.       Pattern$ = x$ + "\" + wild$
  1852.       LINE (112, 88)-(383, 319), 7, BF  'clear the "tree" area
  1853.  
  1854.  
  1855.       GOSUB zzFileSelectBoxII
  1856.       GOTO zzFileSelectBoxProcess
  1857.  
  1858.      CASE 2    'choose new directory
  1859.       IF tree <> levels THEN
  1860.        base$ = ""
  1861.        FOR i = 0 TO tree
  1862.     base$ = base$ + parts$(i)
  1863.     IF MID$(base$, LEN(base$)) <> "\" THEN
  1864.      base$ = base$ + "\"
  1865.     END IF
  1866.        NEXT
  1867.        IF MID$(base$, LEN(base$)) <> "\" THEN
  1868.     base$ = base$ + "\"
  1869.        END IF
  1870.        Pattern$ = base$ + wild$
  1871.        NoDriveSelection = 1
  1872.        GOSUB zzFileSelectBoxII
  1873.        GOTO zzFileSelectBoxProcess
  1874.       END IF
  1875.  
  1876.  
  1877.      CASE 3    'exit with chosen filename
  1878.       Pattern$ = Stuff$
  1879.       RETURN
  1880.  
  1881.      CASE 4    'choose new subdirectory
  1882.       Pattern$ = basex$ + "\" + Directories$(FromDir + dline - 1)
  1883.       Pattern$ = Pattern$ + "\" + wild$
  1884.       NoDriveSelection = 1
  1885.       GOSUB zzFileSelectBoxII
  1886.       GOTO zzFileSelectBoxProcess
  1887.  
  1888.  
  1889.      END SELECT
  1890.  
  1891.     CASE ASC("A") TO ASC("Z")
  1892.      SELECT CASE Column
  1893.      CASE 1
  1894.       i = ASC(stroke$) - 64
  1895.       IF Devices(i) <> 0 THEN
  1896.        dev = Devices(i)
  1897.        GOSUB zzFileSelectBoxAA
  1898.       END IF
  1899.      CASE 3
  1900.       i = FileNames
  1901.       x$ = MID$(FileNames$(i), 1, 1)
  1902.       IF x$ >= stroke$ THEN
  1903.        i = 0
  1904.        DO
  1905.     i = i + 1
  1906.     x$ = MID$(FileNames$(i), 1, 1)
  1907.        LOOP WHILE x$ < stroke$
  1908.       END IF
  1909.       FromFile = i
  1910.       GOSUB zzFileSelectBoxFF
  1911.       fline = 1: GOSUB zzFileSelectBoxCC
  1912.  
  1913.      CASE 4
  1914.       i = Directories
  1915.       x$ = MID$(Directories$(i), 1, 1)
  1916.       IF x$ >= stroke$ THEN
  1917.        i = 0
  1918.        DO
  1919.     i = i + 1
  1920.     x$ = MID$(Directories$(i), 1, 1)
  1921.        LOOP WHILE x$ < stroke$
  1922.       END IF
  1923.       FromDir = i
  1924.       GOSUB zzFileSelectBoxEE
  1925.       dline = 1: GOSUB zzFileSelectBoxBB
  1926.  
  1927.      END SELECT
  1928.     END SELECT
  1929.    ELSE
  1930.     SELECT CASE MID$(stroke$, 2)
  1931.     CASE "I"    'Page UP
  1932.      SELECT CASE Column
  1933.      CASE 3
  1934.       OldFromFile = FromFile
  1935.       IF FromFile + fline > 31 THEN
  1936.        FromFile = FromFile + fline - 31
  1937.       ELSE
  1938.        FromFile = 1
  1939.       END IF
  1940.       IF OldFromFile <> FromFile THEN GOSUB zzFileSelectBoxFF
  1941.       fline = 1: GOSUB zzFileSelectBoxCC
  1942.      CASE 4
  1943.       OldFromDir = FromDir
  1944.       IF FromDir + dline > 31 THEN
  1945.        FromDir = FromDir + dline - 31
  1946.       ELSE
  1947.        FromDir = 1
  1948.       END IF
  1949.       IF OldFromDir <> FromDir THEN GOSUB zzFileSelectBoxEE
  1950.       dline = 1: GOSUB zzFileSelectBoxBB
  1951.      END SELECT
  1952.     CASE "Q"    'Page DN
  1953.      SELECT CASE Column
  1954.      CASE 3
  1955.       OldFromFile = FromFile
  1956.       IF FromFile + fline + 30 < FileNames THEN
  1957.        FromFile = FromFile + fline + 29
  1958.        IF OldFromFile <> FromFile THEN GOSUB zzFileSelectBoxFF
  1959.        fline = 1: GOSUB zzFileSelectBoxCC
  1960.       END IF
  1961.      CASE 4
  1962.       OldFromDir = FromDir
  1963.       IF FromDir + dline + 30 < Directories THEN
  1964.        FromDir = FromDir + dline + 29
  1965.        IF OldFromDir <> FromDir THEN GOSUB zzFileSelectBoxEE
  1966.        dline = 1: GOSUB zzFileSelectBoxBB
  1967.       END IF
  1968.      END SELECT
  1969.     CASE "G"    'HOME
  1970.      SELECT CASE Column
  1971.      CASE 3
  1972.       IF FromFile <> 1 THEN
  1973.        FromFile = 1
  1974.        GOSUB zzFileSelectBoxFF
  1975.       END IF
  1976.       fline = 1: GOSUB zzFileSelectBoxCC
  1977.      CASE 4
  1978.       IF FromDir <> 1 THEN
  1979.        FromDir = 1
  1980.        GOSUB zzFileSelectBoxEE
  1981.       END IF
  1982.       dline = 1: GOSUB zzFileSelectBoxBB
  1983.      END SELECT
  1984.     CASE "O"    'END
  1985.      SELECT CASE Column
  1986.      CASE 3
  1987.       OldFromFile = FromFile
  1988.       FromFile = FileNames - 29
  1989.       IF FromFile < 1 THEN
  1990.        FromFile = 1
  1991.       END IF
  1992.       IF OldFromFile <> FromFile THEN GOSUB zzFileSelectBoxFF
  1993.       fline = 1: GOSUB zzFileSelectBoxCC
  1994.      CASE 4
  1995.       OldFromDir = FromDir
  1996.       FromDir = Directories - 29
  1997.       IF FromDir < 1 THEN
  1998.        FromDir = 1
  1999.       END IF
  2000.       IF OldFromDir <> FromDir THEN GOSUB zzFileSelectBoxEE
  2001.       dline = 1: GOSUB zzFileSelectBoxBB
  2002.      END SELECT
  2003.     CASE "H"    'UP
  2004.      SELECT CASE Column
  2005.      CASE 1     'drives
  2006.       IF dev > 1 THEN
  2007.        dev = dev - 1
  2008.        GOSUB zzFileSelectBoxAA
  2009.       END IF
  2010.      CASE 2     'tree
  2011.       IF tree > 0 THEN
  2012.        tree = tree - 1
  2013.        GOSUB zzFileSelectBoxHH
  2014.       END IF
  2015.      CASE 3     'files
  2016.       i = FromFile + fline - 2
  2017.       IF i > 0 THEN
  2018.        IF fline > 1 THEN
  2019.     fline = fline - 1
  2020.     GOSUB zzFileSelectBoxCC
  2021.        ELSE
  2022.     OldFromFile = FromFile
  2023.     FromFile = FromFile - 30
  2024.     fline = fline + 29
  2025.     IF FromFile < 1 THEN
  2026.      fline = fline + FromFile - 1
  2027.      FromFile = 1
  2028.     END IF
  2029.     IF OldFromFile <> FromFile THEN GOSUB zzFileSelectBoxFF
  2030.     GOSUB zzFileSelectBoxCC
  2031.        END IF
  2032.       END IF
  2033.      CASE 4     'subdirs
  2034.       i = FromDir + dline - 2
  2035.       IF i > 0 THEN
  2036.        IF dline > 1 THEN
  2037.     dline = dline - 1
  2038.     GOSUB zzFileSelectBoxBB
  2039.        ELSE
  2040.     OldFromDir = FromDir
  2041.     FromDir = FromDir - 30
  2042.     dline = dline + 29
  2043.     IF FromDir < 1 THEN
  2044.      dline = dline + FromDir - 1
  2045.      FromDir = 1
  2046.     END IF
  2047.     IF OldFromDir <> FromDir THEN GOSUB zzFileSelectBoxEE
  2048.     GOSUB zzFileSelectBoxBB
  2049.        END IF
  2050.       END IF
  2051.      END SELECT
  2052.  
  2053.     CASE "P"   'DOWN
  2054.      SELECT CASE Column
  2055.      CASE 1     'drives
  2056.       IF dev < MaxDevs THEN
  2057.        dev = dev + 1
  2058.        GOSUB zzFileSelectBoxAA
  2059.       END IF
  2060.      CASE 2     'tree
  2061.       IF tree < levels THEN
  2062.        tree = tree + 1
  2063.        GOSUB zzFileSelectBoxHH
  2064.       END IF
  2065.      CASE 3     'files
  2066.       i = FromFile + fline
  2067.       IF i <= FileNames THEN
  2068.        IF fline < 30 THEN
  2069.     fline = fline + 1
  2070.     GOSUB zzFileSelectBoxCC
  2071.        ELSE
  2072.     FromFile = i: GOSUB zzFileSelectBoxFF
  2073.     fline = 1: GOSUB zzFileSelectBoxCC
  2074.        END IF
  2075.       END IF
  2076.      CASE 4     'subdirs
  2077.       i = FromDir + dline
  2078.       IF i <= Directories THEN
  2079.        IF dline < 30 THEN
  2080.     dline = dline + 1
  2081.     GOSUB zzFileSelectBoxBB
  2082.        ELSE
  2083.     FromDir = i: GOSUB zzFileSelectBoxEE
  2084.     dline = 1: GOSUB zzFileSelectBoxBB
  2085.        END IF
  2086.       END IF
  2087.      END SELECT
  2088.     CASE "K"   'LEFT
  2089.      SELECT CASE Column
  2090.      CASE 2     'from TREE to DRIVES
  2091.       tree = levels
  2092.       GOSUB zzFileSelectBoxHH
  2093.       fg = 8: CALL ziPublishHere(8, 20, "Tree", 2, 1)
  2094.       fg = 4: CALL ziPublishHere(8, 2, "Drives", 2, 1): fg = 0
  2095.       LINE (10, 7)-(Xmax - 10, Ymax - 7), 4, B
  2096.       Column = 1
  2097.      CASE 3     'from FILES to TREE
  2098.       fg = 8: CALL ziPublishHere(8, 51, "Files", 2, 1)
  2099.       fg = 4: CALL ziPublishHere(8, 20, "Tree", 2, 1): fg = 0
  2100.       Column = 2
  2101.      CASE 4     'from SUBDIRS to ?
  2102.       dline = 0: GOSUB zzFileSelectBoxBB
  2103.       fg = 8: CALL ziPublishHere(8, 64, "Subdirs", 2, 1): fg = 4
  2104.       IF FileNames = 0 THEN
  2105.        CALL ziPublishHere(8, 20, "Tree", 2, 1)
  2106.        Column = 2
  2107.       ELSE
  2108.        CALL ziPublishHere(8, 51, "Files", 2, 1)
  2109.        Column = 3
  2110.       END IF
  2111.       fg = 0
  2112.      END SELECT
  2113.  
  2114.     CASE "M"   'RIGHT
  2115.      SELECT CASE Column
  2116.      CASE 1     'from DRIVES to TREE
  2117.       dev = Devices(ASC(base$) - 64)
  2118.       GOSUB zzFileSelectBoxAA     'return to original drive
  2119.       fg = 8: CALL ziPublishHere(8, 2, "Drives", 2, 1)
  2120.       fg = 15: LINE (10, 7)-(Xmax - 10, Ymax - 7), 4, B
  2121.       fg = 4: CALL ziPublishHere(8, 20, "Tree", 2, 1): fg = 0
  2122.       Column = 2
  2123.      CASE 2     'from TREE to ?
  2124.       tree = levels
  2125.       GOSUB zzFileSelectBoxHH
  2126.       IF FileNames = 0 THEN
  2127.        IF Directories <> 0 THEN
  2128.     fg = 8: CALL ziPublishHere(8, 20, "Tree", 2, 1)
  2129.     fg = 4: CALL ziPublishHere(8, 64, "Subdirs", 2, 1): fg = 0
  2130.     dline = 1: GOSUB zzFileSelectBoxBB
  2131.     Column = 4
  2132.        END IF
  2133.       ELSE
  2134.        fg = 8: CALL ziPublishHere(8, 20, "Tree", 2, 1)
  2135.        fg = 4: CALL ziPublishHere(8, 51, "Files", 2, 1): fg = 0
  2136.        Column = 3
  2137.       END IF
  2138.      CASE 3     'from FILES to SUBDIRS (if possible)
  2139.       IF Directories <> 0 THEN
  2140.        fg = 8: CALL ziPublishHere(8, 51, "Files", 2, 1)
  2141.        fg = 4: CALL ziPublishHere(8, 64, "Subdirs", 2, 1): fg = 0
  2142.        dline = 1: GOSUB zzFileSelectBoxBB
  2143.        Column = 4
  2144.       END IF
  2145.      END SELECT
  2146.     END SELECT
  2147.    END IF
  2148.  
  2149.   LOOP
  2150.  
  2151. '   ╔════════════════╗
  2152. '   ║      AA        ╟─────────────────────────────────────────────┐
  2153. '   ╚╤═══════════════╝                                             │
  2154. '    │         change the cursor bar on "dev"                      │
  2155. '    │                                                             │
  2156. '    │         input: dev   output: olddev                         │
  2157. '    └─────────────────────────────────────────────────────────────┘
  2158. zzFileSelectBoxAA:
  2159.  IF dev <> olddev THEN
  2160.   FromRow = 10 + olddev + olddev
  2161.   ToRow = FromRow
  2162.   FromCol = 5
  2163.   ToCol = 10
  2164.   swap1 = bg: swap2 = fg
  2165.   IF olddev > 0 THEN
  2166.    GOSUB zzFileSelectBoxGG
  2167.   END IF
  2168.   FromRow = 10 + dev + dev
  2169.   ToRow = FromRow
  2170.   olddev = dev
  2171.   IF olddev > 0 THEN
  2172.    GOSUB zzFileSelectBoxGG
  2173.   END IF
  2174.  END IF
  2175.  RETURN
  2176.  
  2177.  
  2178.  
  2179. '   ╔════════════════╗
  2180. '   ║      BB        ╟─────────────────────────────────────────────┐
  2181. '   ╚╤═══════════════╝                                             │
  2182. '    │         change the cursor bar on "dline"                    │
  2183. '    │                                                             │
  2184. '    │         input: dline   output: olddline                     │
  2185. '    └─────────────────────────────────────────────────────────────┘
  2186. zzFileSelectBoxBB:
  2187.  IF dline <> olddline THEN
  2188.   FromRow = 10 + olddline
  2189.   ToRow = FromRow
  2190.   FromCol = 67
  2191.   ToCol = 78
  2192.   swap1 = bg: swap2 = fg
  2193.   IF olddline > 0 THEN GOSUB zzFileSelectBoxGG
  2194.   FromRow = 10 + dline
  2195.   ToRow = FromRow
  2196.   olddline = dline
  2197.   IF dline > 0 THEN GOSUB zzFileSelectBoxGG
  2198.  END IF
  2199.  RETURN
  2200.  
  2201.  
  2202.  
  2203. '   ╔════════════════╗
  2204. '   ║      CC        ╟─────────────────────────────────────────────┐
  2205. '   ╚╤═══════════════╝                                             │
  2206. '    │         change the cursor bar on "fline"                    │
  2207. '    │                                                             │
  2208. '    │         input: fline   output: oldfline                     │
  2209. '    └─────────────────────────────────────────────────────────────┘
  2210. zzFileSelectBoxCC:
  2211.  IF fline <> oldfline THEN
  2212.   FromRow = 10 + oldfline
  2213.   ToRow = FromRow
  2214.   FromCol = 51
  2215.   ToCol = 62
  2216.   swap1 = bg: swap2 = fg
  2217.   IF oldfline > 0 THEN
  2218.    GOSUB zzFileSelectBoxGG
  2219.   END IF
  2220.   FromRow = 10 + fline
  2221.   ToRow = FromRow
  2222.   oldfline = fline
  2223.   GOSUB zzFileSelectBoxGG
  2224.   Stuff$ = basex$ + "\" + FileNames$(FromFile + fline - 1)
  2225.   GOSUB zzFileSelectBoxDD
  2226.  END IF
  2227.  RETURN
  2228.  
  2229.  
  2230. '   ╔════════════════╗
  2231. '   ║      DD        ╟─────────────────────────────────────────────┐
  2232. '   ╚╤═══════════════╝                                             │
  2233. '    │     Determine middle of line for publishing "Stuff$"        │
  2234. '    │                                                             │
  2235. '    │                                                             │
  2236. '    └─────────────────────────────────────────────────────────────┘
  2237. zzFileSelectBoxDD:
  2238.  LINE (38, 26)-(601, 46), 3, BF
  2239.  LINE (38, 26)-(601, 46), 8, B
  2240.  CALL ziPublishHere(5, 40 - LEN(Stuff$) \ 2, Stuff$, 1, 2)
  2241.  
  2242.  RETURN
  2243.  
  2244.  
  2245.  
  2246. '   ╔════════════════╗
  2247. '   ║      EE        ╟─────────────────────────────────────────────┐
  2248. '   ╚╤═══════════════╝                                             │
  2249. '    │         Show 30 subdirectories                              │
  2250. '    │                                                             │
  2251. '    │   input: FromDir                                            │
  2252. '    │                                                             │
  2253. '    │                                                             │
  2254. '    └─────────────────────────────────────────────────────────────┘
  2255. zzFileSelectBoxEE:
  2256.  
  2257.  LINE (512, 80)-(Xmax - 11, 319), 7, BF
  2258.  IF FromDir > Directories THEN RETURN
  2259.  IF FromDir > 1 THEN
  2260.   fg = 4: CALL ziPublishHere(11, 65, CHR$(24), 0, 0): fg = 0
  2261.  END IF
  2262.  IF FromDir + 30 <= Directories THEN
  2263.   fg = 4: CALL ziPublishHere(40, 65, CHR$(25), 0, 0): fg = 0
  2264.   j = FromDir + 29
  2265.  ELSE
  2266.   j = Directories
  2267.  END IF
  2268.  
  2269.  FOR i = FromDir TO j
  2270.   k = INSTR(Directories$(i), ".")
  2271.   IF k = 0 THEN
  2272.    x$ = Directories$(i)
  2273.   ELSE
  2274.    x$ = MID$(Directories$(i), 1, k - 1) + SPACE$(8)
  2275.    x$ = MID$(x$, 1, 9) + MID$(Directories$(i), k + 1)
  2276.   END IF
  2277.   CALL ziPublishHere(11 + i - FromDir, 67, x$, 0, 1)
  2278.  NEXT
  2279.  olddline = 0
  2280.  
  2281.  RETURN
  2282.  
  2283.  
  2284. '   ╔════════════════╗
  2285. '   ║      FF        ╟─────────────────────────────────────────────┐
  2286. '   ╚╤═══════════════╝                                             │
  2287. '    │         Show 30 filenames                                   │
  2288. '    │                                                             │
  2289. '    │   input: FromFile                                           │
  2290. '    │                                                             │
  2291. '    │                                                             │
  2292. '    └─────────────────────────────────────────────────────────────┘
  2293. zzFileSelectBoxFF:
  2294.  
  2295.  LINE (384, 80)-(495, 319), 7, BF
  2296.  IF FromFile > FileNames THEN RETURN
  2297.  IF FromFile > 1 THEN
  2298.   fg = 4: CALL ziPublishHere(11, 49, CHR$(24), 0, 0): fg = 0
  2299.  END IF
  2300.  IF FromFile + 30 <= FileNames THEN
  2301.   fg = 4: CALL ziPublishHere(40, 49, CHR$(25), 0, 0): fg = 0
  2302.   j = FromFile + 29
  2303.  ELSE
  2304.   j = FileNames
  2305.  END IF
  2306.  
  2307.  FOR i = FromFile TO j
  2308.   k = INSTR(FileNames$(i), ".")
  2309.   IF k = 0 THEN
  2310.    x$ = FileNames$(i)
  2311.   ELSE
  2312.    x$ = MID$(FileNames$(i), 1, k - 1) + SPACE$(8)
  2313.    x$ = MID$(x$, 1, 9) + MID$(FileNames$(i), k + 1)
  2314.   END IF
  2315.   CALL ziPublishHere(11 + i - FromFile, 51, x$, 0, 0)
  2316.  NEXT
  2317.  oldfline = 0
  2318.  
  2319.  RETURN
  2320.  
  2321.  
  2322. '   ╔════════════════╗
  2323. '   ║      GG        ╟─────────────────────────────────────────────┐
  2324. '   ╚╤═══════════════╝                                             │
  2325. '    │         Swap the colours (swap1 and swap2) of a region      │
  2326. '    │                                                             │
  2327. '    │  input: FromCol, FromRow, ToCol, ToRow, swap1, swap2        │
  2328. '    │                                                             │
  2329. '    │                                                             │
  2330. '    └─────────────────────────────────────────────────────────────┘
  2331. zzFileSelectBoxGG:
  2332.  fx = FromCol * 8 - 8
  2333.  fy = FromRow * 8 - 8
  2334.  tx = ToCol * 8 - 1
  2335.  ty = ToRow * 8 - 1
  2336.  FOR ix = fx TO tx
  2337.   FOR iy = fy TO ty
  2338.    SELECT CASE POINT(ix, iy)
  2339.    CASE swap1
  2340.     PSET (ix, iy), swap2
  2341.    CASE swap2
  2342.     PSET (ix, iy), swap1
  2343.    END SELECT
  2344.   NEXT
  2345.  NEXT
  2346.  RETURN
  2347.  
  2348. '   ╔════════════════╗
  2349. '   ║      HH        ╟─────────────────────────────────────────────┐
  2350. '   ╚╤═══════════════╝                                             │
  2351. '    │         change the cursor bar on "tree"                     │
  2352. '    │                                                             │
  2353. '    │         input: tree   output: oldtree                       │
  2354. '    └─────────────────────────────────────────────────────────────┘
  2355. zzFileSelectBoxHH:
  2356.  IF tree <> oldtree THEN
  2357.   FromRow = 12 + oldtree + oldtree
  2358.   ToRow = FromRow
  2359.   FromCol = 15 + oldtree + oldtree
  2360.   ToCol = FromCol + 11
  2361.   swap1 = bg: swap2 = fg
  2362.   IF oldtree <> 255 THEN
  2363.    GOSUB zzFileSelectBoxGG
  2364.   END IF
  2365.   FromRow = 12 + tree + tree
  2366.   ToRow = FromRow
  2367.   FromCol = 15 + tree + tree
  2368.   ToCol = FromCol + 11
  2369.   oldtree = tree
  2370.   GOSUB zzFileSelectBoxGG
  2371.  END IF
  2372.  RETURN
  2373.  
  2374.  
  2375. '   ╔════════════════╗
  2376. '   ║      II        ╟─────────────────────────────────────────────┐
  2377. '   ╚╤═══════════════╝                                             │
  2378. '    │         clear screen areas when changing directory          │
  2379. '    │                                                             │
  2380. '    │                                                             │
  2381. '    └─────────────────────────────────────────────────────────────┘
  2382. zzFileSelectBoxII:
  2383.  oldtree = 255
  2384.  oldfline = 0
  2385.  olddline = 0
  2386.  LINE (112, 16 * tree + 80)-(383, 319), 7, BF
  2387.  LINE (384, 56)-(495, 319), 7, BF
  2388.  LINE (504, 56)-(Xmax - 11, 319), 7, BF
  2389.  Stuff$ = "(Please Wait)"
  2390.  fg = 14: GOSUB zzFileSelectBoxDD: fg = 0
  2391.  RETURN
  2392.  
  2393. END SUB
  2394.  
  2395. '<p>
  2396. '++++++++++++++++++++++++
  2397. SUB zzInPath (Field$)
  2398.  
  2399.   x$ = ".;" + ENVIRON$("PATH")
  2400.   IF RIGHT$(x$, 1) <> ";" THEN x$ = x$ + ";"
  2401.   i = 1
  2402.   DO
  2403.     j = INSTR(i, x$, ";")
  2404.     IF j THEN
  2405.       y$ = UCASE$(MID$(x$, i, j - i))
  2406.       i = j + 1
  2407.       IF RIGHT$(y$, 1) <> "\" THEN y$ = y$ + "\"
  2408.       f$ = y$ + Field$
  2409.       Bad = 0
  2410.       OPEN "I", 1, f$
  2411.       IF Bad = 0 THEN
  2412.     CLOSE 1
  2413.     EXIT DO
  2414.       END IF
  2415.       f$ = ""
  2416.     END IF
  2417.   LOOP WHILE j
  2418.   Bad = 0
  2419.   Field$ = f$
  2420.  
  2421. END SUB
  2422.  
  2423. '<p>
  2424. '++++++++++++++++++++++++
  2425. SUB zzSearchD (Pattern$)
  2426.  
  2427. DIM str AS STRING * 65
  2428.  
  2429.  CALL zzCritOff
  2430.  GOSUB zzSearchDProcess
  2431.  CALL zzCritOn
  2432.  
  2433.  EXIT SUB
  2434.  
  2435. zzSearchDProcess:
  2436.   upperbound = UBOUND(Directories$)
  2437.   str = LTRIM$(RTRIM$(UCASE$(Pattern$)))
  2438.   Pattern$ = "?"
  2439.  
  2440. ' clear the Directories$ array
  2441.  
  2442.  FOR i = 1 TO 500
  2443.   Directories$(i) = ""
  2444.  NEXT
  2445.  Directories = 0
  2446.  
  2447. ' locate the DTA
  2448.  
  2449.  Regs.AX = &H2F00
  2450.  CALL zzBasicInt(&H21)
  2451.  DTAseg = Regs.ES
  2452.  DTAptr = Regs.BX
  2453.  
  2454. ' confirm that the drive (if specified) is valid
  2455.  
  2456.  IF MID$(str, 2, 1) = ":" THEN
  2457.   i = ASC(str)
  2458.   IF i < 65 THEN RETURN
  2459.   IF i > 90 THEN RETURN
  2460.   Regs.AX = &H440E
  2461.   Regs.BX = i - 64
  2462.   CALL zzBasicInt(&H21)
  2463.   IF (Regs.FL AND 256) <> 256 THEN
  2464.    j = Regs.AX AND 255
  2465.    IF (j <> 0) AND (j <> i - 64) THEN
  2466.     i = j + 64
  2467.    END IF
  2468.   END IF
  2469.   Regs.AX = &H1C00
  2470.   Regs.DX = i - 64
  2471.   CALL zzBasicInt(&H21)
  2472.   IF (Regs.AX AND 255) = 255 THEN RETURN
  2473.  END IF
  2474.  
  2475.  x$ = RTRIM$(str)
  2476.  IF (x$ = "") OR (MID$(x$, 2) = ":") THEN
  2477.   x$ = x$ + "*.*"
  2478.  END IF
  2479.  IF (MID$(x$, LEN(x$)) = "\") THEN
  2480.   x$ = x$ + "*.*"
  2481.  END IF
  2482.  
  2483.  IF INSTR(x$, "*") + INSTR(x$, "?") = 0 THEN
  2484.   x$ = x$ + "\*.*"
  2485.  END IF
  2486.  
  2487.  
  2488. ' initiate the search
  2489.  
  2490.  Pattern$ = x$
  2491.  str = x$ + CHR$(0)
  2492.  Regs.AX = &H4E00
  2493.  Regs.CX = &H10
  2494.  Regs.DS = VARSEG(str)
  2495.  Regs.DX = VARPTR(str)
  2496.  CALL zzBasicInt(&H21)
  2497.  
  2498.  DO WHILE (Regs.FL AND 256) = 0
  2499.   DEF SEG = DTAseg
  2500.  
  2501. ' pull the name (letter by letter) from the DTA
  2502.  
  2503.   IF (PEEK(DTAptr + &H15) AND &H10) = &H10 THEN
  2504.    Name$ = ""
  2505.    i = &H1E
  2506.    DO
  2507.     j = PEEK(DTAptr + i)
  2508.     IF j <> 0 THEN
  2509.      Name$ = Name$ + CHR$(j)
  2510.     END IF
  2511.     i = i + 1
  2512.    LOOP UNTIL j = 0
  2513.  
  2514. ' omit "." and ".."
  2515.  
  2516.    IF MID$(Name$, 1, 1) <> "." THEN
  2517.     Directories = Directories + 1
  2518.     IF Directories > upperbound THEN RETURN
  2519.     Directories$(Directories) = Name$
  2520.    END IF
  2521.   END IF
  2522.  
  2523. ' keep going until all matches are found
  2524.  
  2525.   Regs.AX = &H4F00
  2526.   CALL zzBasicInt(&H21)
  2527.  LOOP
  2528.  
  2529. ' now find the first byte of the directory pattern itself
  2530.  
  2531.  IF MID$(str, 2, 1) = ":" THEN
  2532.   start = 3
  2533.  ELSE
  2534.   start = 1
  2535.  END IF
  2536.  DO
  2537.   i = INSTR(start, str, "\")
  2538.   IF i <> 0 THEN
  2539.    start = i + 1
  2540.   END IF
  2541.  LOOP UNTIL i = 0
  2542.  x$ = MID$(str, 1, start - 1)
  2543.  CALL zzValidate(x$)
  2544.  IF MID$(x$, LEN(x$)) <> "\" THEN x$ = x$ + "\"
  2545.  i = INSTR(str, CHR$(0))
  2546.  
  2547.  Pattern$ = RTRIM$(x$ + MID$(str, start, i - start))
  2548.  
  2549.  IF Directories <> 0 THEN
  2550.   SortCount = Directories
  2551.   CALL zzAlphaSort(Directories$())
  2552.  END IF
  2553.  RETURN
  2554. END SUB
  2555.  
  2556. '<p>
  2557. '++++++++++++++++++++++++
  2558. SUB zzSearchF (Pattern$)
  2559.  
  2560. DIM str AS STRING * 65
  2561.  
  2562.  CALL zzCritOff
  2563.  GOSUB zzSearchFProcess
  2564.  CALL zzCritOn
  2565.  
  2566.  EXIT SUB
  2567.  
  2568. zzSearchFProcess:
  2569.  upperbound = UBOUND(FileNames$)
  2570.  str = LTRIM$(RTRIM$(UCASE$(Pattern$)))
  2571.  Pattern$ = "?"
  2572.  
  2573. ' clear the FileNames$ array
  2574.  
  2575.  FOR i = 1 TO 500
  2576.   FileNames$(i) = ""
  2577.  NEXT
  2578.  FileNames = 0
  2579.  
  2580. ' locate the DTA
  2581.  
  2582.  Regs.AX = &H2F00
  2583.  CALL zzBasicInt(&H21)
  2584.  DTAseg = Regs.ES
  2585.  DTAptr = Regs.BX
  2586.  
  2587. ' confirm that the drive (if specified) is valid
  2588.  
  2589.  IF MID$(str, 2, 1) = ":" THEN
  2590.   i = ASC(str)
  2591.   IF i < 65 THEN RETURN
  2592.   IF i > 90 THEN RETURN
  2593.   Regs.AX = &H440E
  2594.   Regs.BX = i - 64
  2595.   CALL zzBasicInt(&H21)
  2596.   IF (Regs.FL AND 256) <> 256 THEN
  2597.    j = Regs.AX AND 255
  2598.    IF (j <> 0) AND (j <> i - 64) THEN
  2599.     i = j + 64
  2600.    END IF
  2601.   END IF
  2602.   Regs.AX = &H1C00
  2603.   Regs.DX = i - 64
  2604.   CALL zzBasicInt(&H21)
  2605.   IF (Regs.AX AND 255) = 255 THEN RETURN
  2606.  END IF
  2607.  
  2608.  x$ = RTRIM$(str)
  2609.  IF (x$ = "") OR (MID$(x$, 2) = ":") THEN
  2610.   x$ = x$ + "*.*"
  2611.  END IF
  2612.  IF (MID$(x$, LEN(x$)) = "\") THEN
  2613.   x$ = x$ + "*.*"
  2614.  END IF
  2615.  
  2616.  IF INSTR(x$, "*") + INSTR(x$, "?") = 0 THEN
  2617.   x$ = x$ + "\*.*"
  2618.  END IF
  2619.  
  2620. ' initiate the search
  2621.  
  2622.  Pattern$ = x$
  2623.  str = x$ + CHR$(0)
  2624.  Regs.AX = &H4E00
  2625.  Regs.CX = &H27
  2626.  Regs.DS = VARSEG(str)
  2627.  Regs.DX = VARPTR(str)
  2628.  CALL zzBasicInt(&H21)
  2629.  
  2630.  DO WHILE (Regs.FL AND 256) = 0
  2631.   DEF SEG = DTAseg
  2632.  
  2633. ' pull the name (letter by letter) from the DTA
  2634.  
  2635.   Name$ = ""
  2636.   i = &H1E
  2637.   DO
  2638.    j = PEEK(DTAptr + i)
  2639.    IF j <> 0 THEN
  2640.     Name$ = Name$ + CHR$(j)
  2641.    END IF
  2642.    i = i + 1
  2643.   LOOP UNTIL j = 0
  2644.  
  2645.   FileNames = FileNames + 1
  2646.   IF FileNames > upperbound THEN RETURN
  2647.   FileNames$(FileNames) = Name$
  2648.  
  2649.   Regs.AX = &H4F00
  2650.   CALL zzBasicInt(&H21)
  2651.  LOOP
  2652.  
  2653.  
  2654. ' now find the first byte of the file pattern itself
  2655.  
  2656.  IF MID$(str, 2, 1) = ":" THEN
  2657.   start = 3
  2658.  ELSE
  2659.   start = 1
  2660.  END IF
  2661.  DO
  2662.   i = INSTR(start, str, "\")
  2663.   IF i <> 0 THEN
  2664.    start = i + 1
  2665.   END IF
  2666.  LOOP UNTIL i = 0
  2667.  x$ = MID$(str, 1, start - 1)
  2668.  CALL zzValidate(x$)
  2669.  IF MID$(x$, LEN(x$)) <> "\" THEN x$ = x$ + "\"
  2670.  i = INSTR(str, CHR$(0))
  2671.  
  2672.  Pattern$ = RTRIM$(x$ + MID$(str, start, i - start))
  2673.  
  2674.  IF FileNames <> 0 THEN
  2675.   SortCount = FileNames
  2676.   CALL zzAlphaSort(FileNames$())
  2677.  END IF
  2678.  RETURN
  2679. END SUB
  2680.  
  2681. '<p>
  2682. '++++++++++++++++++++++++
  2683. SUB zzValidate (Directory$)
  2684.  
  2685. DIM str AS STRING * 65
  2686.  
  2687.  CALL zzCritOff
  2688.  GOSUB zzValidateProcess
  2689.  CALL zzCritOn
  2690.  
  2691.  EXIT SUB
  2692.  
  2693. zzValidateProcess:
  2694.  
  2695.  Candpath$ = LTRIM$(RTRIM$(UCASE$(Directory$)))
  2696.  IF MID$(Candpath$, LEN(Candpath$)) = "\" THEN
  2697.   IF LEN(Candpath$) > 1 THEN
  2698.    IF MID$(Candpath$, 2) <> ":\" THEN
  2699.     Candpath$ = MID$(Candpath$, 1, LEN(Candpath$) - 1)
  2700.    END IF
  2701.   END IF
  2702.  END IF
  2703.  
  2704.  Directory$ = "?"
  2705.  
  2706. ' check that any named drive is valid
  2707.  
  2708.  IF MID$(Candpath$, 2, 1) = ":" THEN
  2709.   i = ASC(MID$(Candpath$, 1, 1))
  2710.   IF i < 65 THEN RETURN
  2711.   IF i > 90 THEN RETURN
  2712.   Regs.AX = &H440E
  2713.   Regs.BX = i - 64
  2714.   CALL zzBasicInt(&H21)
  2715.   IF (Regs.FL AND 256) <> 256 THEN
  2716.    j = Regs.AX AND 255
  2717.    IF (j <> 0) AND (j <> i - 64) THEN
  2718.     i = j + 64
  2719.    END IF
  2720.   END IF
  2721.   Regs.AX = &H1C00
  2722.   Regs.DX = i - 64
  2723.   CALL zzBasicInt(&H21)
  2724.   IF (Regs.AX AND 255) = 255 THEN RETURN
  2725.  END IF
  2726.  
  2727. ' handle special case of root directory
  2728.  
  2729.  IF Candpath$ = "\" THEN
  2730.   Directory$ = ""
  2731.   CALL zzChangeDrive(Directory$)
  2732.   Directory$ = Directory$ + "\"
  2733.   RETURN
  2734.  END IF
  2735.  IF MID$(Candpath$, 2) = ":\" THEN
  2736.   Directory$ = Candpath$
  2737.   RETURN
  2738.  END IF
  2739.  
  2740. ' handle special case of NO directory
  2741.  
  2742.  IF Candpath$ = "" THEN
  2743.   CALL zzChangeDir(Candpath$)
  2744.   Directory$ = Candpath$
  2745.   RETURN
  2746.  END IF
  2747.  IF MID$(Candpath$, 2) = ":" THEN
  2748.   Regs.AX = &H4700
  2749.   Regs.DX = ASC(MID$(Candpath$, 1, 1)) - 64
  2750.   Regs.DS = VARSEG(str)
  2751.   Regs.SI = VARPTR(str)
  2752.   CALL zzBasicInt(&H21)
  2753.   i = INSTR(str, CHR$(0))
  2754.   Directory$ = Candpath$ + "\" + MID$(str, 1, i - 1)
  2755.   RETURN
  2756.  END IF
  2757.  
  2758.  str = Candpath$ + CHR$(0)
  2759.  IF INSTR(str, "*") + INSTR(str, "?") > 0 THEN RETURN
  2760.  
  2761.  
  2762. ' initiate the search
  2763.  
  2764.  Regs.AX = &H4E00
  2765.  Regs.CX = &H10
  2766.  Regs.DS = VARSEG(str)
  2767.  Regs.DX = VARPTR(str)
  2768.  CALL zzBasicInt(&H21)
  2769.  
  2770. ' abandon if not a valid directory
  2771.  
  2772.  IF (Regs.FL AND 256) <> 0 THEN RETURN
  2773. ' locate the DTA
  2774.  
  2775.  Regs.AX = &H2F00
  2776.  CALL zzBasicInt(&H21)
  2777.  DTAseg = Regs.ES
  2778.  DTAptr = Regs.BX
  2779.  
  2780.  DEF SEG = DTAseg
  2781.  attr = PEEK(DTAptr + &H15)
  2782.  IF (attr AND &H10) = 0 THEN RETURN
  2783.  
  2784. ' establish the status quo so that we can change back
  2785.  
  2786.  olddrv$ = ""
  2787.  CALL zzChangeDrive(olddrv$)
  2788.  
  2789.  IF MID$(str, 2, 1) = ":" THEN
  2790.   newdrv$ = MID$(str, 1, 2)
  2791.  ELSE
  2792.   newdrv$ = olddrv$
  2793.  END IF
  2794.  
  2795.  CALL zzChangeDrive(newdrv$)    'change to new drive
  2796.  olddir$ = ""
  2797.  CALL zzChangeDir(olddir$)      'find the current directory on new drive
  2798.  CALL zzChangeDir(str)          'change to the desired directory
  2799.  CALL zzChangeDir(olddir$)      'change back to the current directory
  2800.  CALL zzChangeDrive(olddrv$)    'change back to old drive
  2801.  IF Root = 0 THEN
  2802.   Directory$ = RTRIM$(str)
  2803.  ELSE
  2804.   Directory$ = MID$(str, 1, 2) + "\"
  2805.  END IF
  2806.  RETURN
  2807.  
  2808. END SUB
  2809.  
  2810.